(*:Collection of Win32 wrappers and helper functions.
   @desc <pre>
   Free for personal and commercial use. No rights reserved.

   Maintainer        : gabr
   Contributors      : ales, aoven, gabr, Lee_Nover, _MeSSiah_, Miha-R, Odisej, xtreme,
                       Brdaws, Gre-Gor, krho, Cavlji, radicalb, fora, M.C, MP002, Mitja,
                       Christian Wimmer, Tommi Prami, Miha
   Creation date     : 2002-10-09
   Last modification : 2012-04-20
   Version           : 1.66
</pre>*)(*
   History:
     1.66: 2012-04-20
       - TDSiRegistry.ReadBinary, WriteBinary now use RawByteString for data buffer.
     1.65: 2012-02-06
       - Implemented DSiSetFileTime and DSiSetFileTimes.
       - Implemented DSiDateTimeToFileTime.
     1.64b: 2012-01-11
       - Set msg.Result := 0; in DSiClassWndProc.
     1.64a: 2011-12-20
       - DSiAllocateHWnd works in 64-bit mode.
       - Fixed 64-bit DSiInterlockedExchangeAdd64.
     1.64: 2011-12-16
       - [GJ] Assembler implementation of the x64 version of Interlocked*64 family of functions.
     1.63: 2011-10-21
       - Interlocked*64 family implemented using Windows' InterlockedCompareExchange64
         on Win64-bit platform.
       - Removed dependency on the Consts unit.
       - Scoped unit names are used in XE2.
     1.62a: 2011-11-07
       - Compiles with XE2 (in 32-bit mode).
     1.62: 2011-09-26
       - Implemented DSiGetThreadTime (two overloaded versions).
     1.61c: 2011-07-26
       - [miha] SetErrorMode (SEM_NOOPENFILEERRORBOX) is called before LoadLibrary to 
         prevent opening messagebox by Windows.
     1.61b: 2011-06-27
       - [tommi prami] Compiles with D7.
     1.61a: 2011-05-06
       - [achim] DSiAddApplicationToFirewallExceptionListXP could fail with "Unknown
         resoveConflict" exception due to a syntax error.
     1.61: 2011-03-01
       - Faster DSiFileExtensionIs.
     1.60: 2010-12-04
       - When compiled with D2007 or newer, unit FileCtrl is not included.
     1.59b: 2010-10-28
       - Call UniqueString before calling CreateProcessW.
     1.59a: 2010-09-25
       - [Tommi Prami] Added types missing in Delphi 7.
     1.59: 2010-09-24
       - Added function DSiDisableStandby that will try to disable standby and hibernate
         on Windows XP SP 2 and newer.
     1.58a: 2010-09-19
       - Define TStartupInfoW in Delphi 7 and earlier.
     1.58: 2010-07-27
       - DSiAddApplicationToFirewallExceptionList[Advanced|XP] got a new parameter
         TDSiFwResolveConflict (default rcDuplicate) where the caller can specify
         behaviour if the rule with the same name already exists.
         [rcDuplicate = add new rule with the same name, rcOverwrite = remove all rules
          with the same name and then add the new rule, rcSkip = leave existing rules
          intact and don't add the new rule]
       - Implemented DSiFindApplicationInFirewallExceptionList[Advanced|XP].
     1.57a: 2010-07-20
       - Bug fix in DSiAddApplicationToFirewallExceptionListAdvanced: setting
         rule.ServiceName to '' caused fwPolicy2.Rules.Add(rule) to raise exception.
     1.57: 2010-06-18
       - DSiExecuteAsUser now calls CreateProcessWithLogonW if CreateProcessAsUser fails
         with ERROR_PRIVILEGE_NOT_HELD (1314). Windows error code is now returned in a
         parameter. Window station and desktop process-specific ACEs are removed in a
         background thread when child process exits (thanks to Christian Wimmer to pointing
         out this problem). If the username is not set, DSiExecuteAsUser still sets up
         ACEs for window station/desktop access but ends calling CreateProcess and does
         not remove ACEs at the end.
       - Two overloaded versions of DSiExecuteAsUser are implemented. One is backwards
         compatible and another introduces two parameters -
         out processInfo: TProcessInformation and startInfo: PStartupInfo (default: nil).
         If the latter is assigned, it will be used instead of the internally generated
         TStartupInfo. This version does not close process and thread handle returned
         in the TProcessInformation if 'wait' is False.
       - Implemented DSiRemoveAceFromWindowStation and DSiRemoveAceFromDesktop.
       - Added dynamically loaded API forwarders DSiCreateProcessWithLogonW,
         DSiCreateEnvironmentBlock, DSiDestroyEnvironmentBlock and
         DSiGetUserProfileDirectoryW.
       - DSiAddAceTo[WindowStation|Desktop] will not add SID if it already exists in the
         ACL.
     1.56: 2010-06-10
       - [Mitja] Clear the last error if CreateProcess succeeds in DSiExecuteAndCapture
         (found a test case where CreateProcess succeeded but last error was 126).
       - [Christian Wimmer] In Unicode Delphis, DSiOpenSCManager, DSiGetLongPathName,
         DSiGetModuleFileNameEx, DSiGetProcessImageFileName, DSiSetDllDirectory, and
         DSiSHEmptyRecycleBin were linking to the wrong verison of the API.
       - [Christian Wimmer] DSiCreateProcessAsUser must make a local copy of the
         commandLine parameter when using Unicode API because the API may modify the
         contents of this parameter.
       - Implemented DSiGetLogonSID, DSiAddAceToWindowStation and DSiAddAceToDesktop.
       - Redesigned DSiExecuteAsUser.
     1.55: 2010-04-12
       - Implemented DSiHasElapsed64 and DSiElapsedTime64.
     1.54: 2010-04-08
       - Implemented DSiLogonAs and DSiVerifyPassword.
     1.53c: 2010-02-01
       - DSiGetProcAddress made public.
     1.53b: 2009-12-15
       - Fixed Delphi 5 compilation.
     1.53a: 2009-11-24
       - Fixed TDSiRegistry.ReadVariant and WriteVariant to work with varUString
         (also fixes all sorts of TDSiRegistry problems in Delphi 2010.)
     1.53: 2009-11-13
       - Implemented DSiDeleteRegistryValue.
       - Added parameter 'access' to the DSiKillRegistry.
     1.52a: 2009-11-04
       - [Mitja] Fixed allocation in DSiGetUserName.
       - [Mitja] Also catch 'error' output in DSiExecuteAndCapture.
     1.52: 2009-10-28
       - DSiAddApplicationToFirewallExceptionList renamed to
         DSiAddApplicationToFirewallExceptionListXP.
       - Added DSiAddApplicationToFirewallExceptionListAdvanced which uses Advanced
         Firewall interface, available on Vista+.
       - DSiAddApplicationToFirewallExceptionList now calls either
         DSiAddApplicationToFirewallExceptionListXP or
         DSiAddApplicationToFirewallExceptionListAdvanced, depending on OS version.
       - Implemented functions to remove application from the firewall exception list:
         DSiRemoveApplicationFromFirewallExceptionList,
         DSiRemoveApplicationFromFirewallExceptionListAdvanced,
         DSiRemoveApplicationFromFirewallExceptionListXP.
     1.51a: 2009-10-27
       - Convert non-EOleSysError exceptions in DSiAddApplicationToFirewallExceptionList
         into ERROR_INVALID_FUNCTION error.
     1.51: 2009-10-22
       - Added 'onNewLine' callback to the DSiExecuteAndCapture. This event reports
         program output line-by-line in real time and it can extend total time allowed
         for program execution.
     1.50: 2009-10-20
       - [Mitja] Updated DSiExecuteAndCapture: settable timeout, Unicode Delphi support,
         LastError is set if CreateProcess fails.
       - Implemented functions DSiGetSubstDrive and DSiGetSubstPath.
     1.49: 2009-10-12
       - Added 'access' parameter to the DSiWriteRegistry methods so that user can
         request writing to the non-virtualized key when running on 64-bit system
         (KEY_WOW64_64KEY).
     1.48: 2009-10-09
       - Defined TOSVersionInfoEx record and corresponding constants.
       - Extended DSiGetWindowsVersion to return wvWinServer2008, wvWin7 and
         wvWinServer2008R2.
       - Extended DSiGetTrueWindowsVersion to return wvWinServer2008OrVistaSP1 and
         wvWin7OrServer2008R2.
     1.47a: 2009-09-03
       - Added parameter connectionIsAvailable to the DSiGetNetworkResource.
     1.47: 2009-05-22
       - Added dynamically loaded API forwarder DSiGetTickCount64.
     1.46: 2009-03-17
       - Added dynamically loaded API forwarders DSiWow64DisableWow64FsRedirection and
         DSiWow64RevertWow64FsRedirection.
       - Implemented function DSiDisableWow64FsRedirection and DSiRevertWow64FsRedirection.
     1.45: 2009-03-16
       - Implemented DSiGetCurrentThreadHandle and DSiGetCurrentProcessHandle.
     1.44a: 2009-02-28
       - Added D2009 compatibility fixes to DSiGetFolderLocation, DSiGetNetworkResource,
         DSiGetComputerName, DSiGetWindowsFolder.
       - Fixed DSiGetTempFileName, DSiGetUserName.
     1.44: 2009-02-05
       - Added functions DSiAddApplicationToFirewallExceptionList and
         DSiAddPortToFirewallExceptionList.
     1.43: 2009-01-28
       - Added functions DSiGetNetworkResource, DSiDisconnectFromNetworkResource.
     1.42: 2009-01-23
       - Added functions DSiGetGlobalMemoryStatus, DSiGlobalMemoryStatusEx.
     1.41: 2008-08-20
       - Delphi 2009 compatibility.
     1.40c: 2008-07-14
       - Bug fixed: It was not possible to use DSiTimeGetTime64 in parallel from multiple
         threads
     1.40b: 2008-07-11
       - Forced {$T-} as the code doesn't compile in {$T+} state.
     1.40a: 2008-06-23
       - Added constants FILE_LIST_DIRECTORY, FILE_SHARE_FULL, FILE_ACTION_ADDED,
         FILE_ACTION_REMOVED, FILE_ACTION_MODIFIED, FILE_ACTION_RENAMED_OLD_NAME,
         FILE_ACTION_RENAMED_NEW_NAME.
     1.40: 2008-05-30
       - Added function DSiCopyFileAnimated.
     1.39: 2008-05-05
       - Added function DSiConnectToNetworkResource.
     1.38: 2008-04-29
       - Added functions to copy HTML format to and from the clipboard:
         DSiIsHtmlFormatOnClipboard, DSiGetHtmlFormatFromClipboard,
         DSiCopyHtmlFormatToClipboard.
     1.37: 2008-03-27
       - Created DSiInterlocked*64 family of functions by copying the code from
         http://qc.borland.com/wc/qcmain.aspx?d=6212. Functions were written by
         Will DeWitt Jr [edge@icehouse.net] and are included with permission.
       - Implemented DSiYield.
     1.36a: 2008-01-16
       - Changed DSiIsAdmin to use big enough buffer for token data.
       - Changed DSiIsAdmin to ignore SE_GROUP_ENABLED attribute because function was
         sometimes incorrectly returning False.
     1.36: 2007-12-29
       - Added procedures DSiCenterRectInRect and DSiMakeRectFullyVisibleOnRect.
     1.35: 2007-12-17
       - Added DSiTerminateProcessById procedure.
     1.34: 2007-12-03
       - Added three performance counter helpers DSiPerfCounterToMS, DSiPerfCounterToUS,
         and DSiQueryPerfCounterAsUS.
     1.33: 2007-11-26
       - Added function DSiTimeGetTime64.
     1.32: 2007-11-13
       - Added parameter 'parameters' to DSiCreateShortcut and DSiGetShortcutInfo.
       - Added function DSiEditShortcut.
       - Added function DSiInitFontToSystemDefault. 
     1.31: 2007-11-06
       - Added SHGetSpecialFolderLocation folder constants: CSIDL_ALTSTARTUP,
         CSIDL_CDBURN_AREA, CSIDL_COMMON_ALTSTARTUP, CSIDL_COMMON_DESKTOPDIRECTORY,
         CSIDL_COMMON_FAVORITES, CSIDL_COMMON_MUSIC, CSIDL_COMMON_PICTURES,
         CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_STARTUP,
         CSIDL_COMMON_TEMPLATES, CSIDL_COMMON_VIDEO, CSIDL_COMPUTERSNEARME,
         CSIDL_CONNECTIONS, CSIDL_COOKIES, CSIDL_INTERNET, CSIDL_INTERNET_CACHE,
         CSIDL_MYDOCUMENTS, CSIDL_MYMUSIC, CSIDL_MYVIDEO, CSIDL_PHOTOALBUMS,
         CSIDL_PLAYLISTS, CSIDL_PRINTHOOD, CSIDL_PROFILE, CSIDL_RESOURCES,
         CSIDL_SAMPLE_MUSIC, CSIDL_SAMPLE_PLAYLISTS, CSIDL_SAMPLE_PICTURES,
         CSIDL_SAMPLE_VIDEOS.
       - Added ShGetSpecialFolderLocation flags CSIDL_FLAG_DONT_UNEXPAND and
         CSIDL_FLAG_DONT_VERIFY.
       - Added dynamically loaded API forwarder DSiSetSuspendState.
       - Added dynamically loaded API forwarders DSiEnumProcessModules,
         DSiGetModuleFileNameEx, and DSiGetProcessImageFileName.
       - Added function DSiGetProcessFileName.
       - More stringent checking in DSiGetProcessWindow.
       - Fixed DSiLoadLibrary so that it can be called before initialization section is
         executed. Somehow, D2007 doesn't always call initialization sectins in correct
         order >:-(
     1.30: 2007-10-25
       - Added dynamically loaded API forwarders DSiDwmEnableComposition and
         DsiDwmIsCompositionEnabled.
       - Added Aero group with functions DSiAeroDisable, DSiAeroEnable, and
         DSiAeroIsEnabled.
     1.29: 2007-10-03
       - Added function DSiIsAdmin.
     1.28a: 2007-09-12
       - TDSiTimer properties changed from published to public.
     1.28: 2007-07-25
       - Added function DSiMoveFile.
       - Small changes in DSiMoveOnReboot.
     1.27: 2007-07-11
       - Added two overloaded functions DSiGetThreadTimes.
     1.26: 2007-06-13
       - Added two overloaded function DSiFileExtensionIs.
     1.25: 2007-05-30
       - Added thread-safe alternative to (De)AllocateHwnd - DSi(De)AllocateHwnd.
       - Added TDSiTimer - a TTimer clone that uses DSi(De)AllocateHwnd internally.
       - New function DSiGetFolderSize.
       - Bug fixed: GetProcAddress result was not checked in DSiRegisterActiveX.
     1.24: 2007-03-21
       - Added support for search depth limitation to DSiEnumFilesEx and 
         DSiEnumFilesToSL.
     1.23: 2007-02-14
       - New functions: DSiGetProcessTimes (two overloaded versions), DSiGetFileTimes,
         DSiFileTimeToDateTime (two overloaded versions), DSiFileTimeToMicroSeconds,
         DSiGetProcessMemoryInfo, DSiGetProcessMemory (two overloaded versions),
         DSiIsWow64, DSiGetAppCompatFlags, DSiGetTrueWindowsVersion.
       - New dynamically loaded API forwarder: DSiIsWow64Process.
       - Added parameter 'access' to DSiReadRegistry, DSiRegistryKeyExists, and
         DSiRegistryValueExists functions.
     1.22: 2006-12-07
       - New function: DSiGetFileTime.
       - Added Windows Vista detection to DSiGetWindowsVersion.
     1.21: 2006-08-14
       - New functions: DSiFileExistsW, DSiDirectoryExistsW, DSiFileSizeW,
         DSiCompressFile, DSiUncompressFile, DSiIsFileCompressed, DSiIsFileCompressedW.
     1.20: 2006-06-20
       - New function: DSiGetShortcutInfo.
     1.19: 2006-05-15
       - New functions: DSiEnumFilesToSL, DSiGetLongPathName.
     1.18: 2006-04-11
       - New function: DSiSetDllDirectory.
     1.17a: 2006-04-05
       - Exit DSiProcessMessages when WM_QUIT is received.
     1.17: 2006-03-14
       - New function: DSiRegistryValueExists.
       - Added 'working dir' parameter to the DSiCreateShortcut function.
     1.16: 2006-01-23
       - New DSiExecuteAndCapture implementation, contributed by matej.
     1.15b: 2005-12-19
       - TDSiRegistry.ReadInteger can now also read 4-byte binary values.
     1.15a: 2005-08-09
       - Removed StrNew from DSiGetComputerName because it caused the result never to
         be released.
     1.15: 2005-07-11
       - New function: DSiWin32CheckNullHandle.
     1.14: 2005-06-09
       - New function: DSiGetEnvironmentVariable.
       - DSiExecuteAndCapture modified to return exit code in a (newly added) parameter
         and fixed to work on fast computers.
     1.13a: 2005-03-15
       - Make DSiGetTempFileName return empty string when GetTempFileName fails. 
     1.13: 2005-02-12
       - New functions: DSiExitWindows, DSiGetSystemLanguage, DSiGetKeyboardLayouts.
       - New methods: TDSiRegistry.ReadBinary (two overloaded versions),
         TDSiRegistry.WriteBinary (two overloaded versions).
       - Added OLE string processing to TDSiRegistry.ReadVariant and
         TDSiRegistry.WriteVariant.
       - Exported helper functions UTF8Encode and UTF8Decode for old Delphis (D5 and
         below).
       - Added Windows 2003 detection to DSiGetWindowsVersion.
       - Modified DSiEnablePrivilege to return True without doint anything on 9x platform.
       - Fixed handle leak in DSiSetProcessPriorityClass.
       - Removed some dead code.
       - Documented the Information segment.
     1.12: 2004-09-21
       - Added function DSiIncrementWorkingSet.
     1.11: 2004-02-12
       - Added functions DSiSetProcessPriorityClass, DSiGetProcessOwnerInfo (two
         overloaded versions), DSiEnablePrivilege.
     1.10: 2003-12-18
       - Updated TDSiRegistry.ReadString to handle DWORD registry values too.
       - Updated TDSiRegistry.ReadInteger to handle string registry values too.
     1.09: 2003-11-14
       - Added functions DSiValidateProcessAffinity, DSiValidateThreadAffinity,
         DSiValidateProcessAffinityMask, DSiValidateThreadAffinityMask,
         DSiGetSystemAffinityMask, DSiGetProcessAffinityMask,
         DSiGetThreadAffinityMask, DSiAffinityMaskToString, and
         DSiStringToAffinityMask.
     1.08: 2003-11-12
       - Added functions DSiCloseHandleAndInvalidate, DSiWin32CheckHandle,
         DSiGetSystemAffinity, DSiGetProcessAffinity, DSiSetProcessAffinity,
         DSiGetThreadAffinity, DSiSetThreadAffinity.
       - Added types TDSiFileHandle, TDSiPipeHandle, TDSiMutexHandle, TDSiEventHandle,
         TDSiSemaphoreHandle; all equivaled to THandle.
     1.07a: 2003-10-18
       - DSiuSecDelay was broken. Fixed.
     1.07: 2003-10-09
       - Added functions DSiGetUserNameEx, DSiIsDiskInDrive, DSiGetDiskLabel,
         DSiGetMyDocumentsFolder, DSiGetSystemVersion, DSiRefreshDesktop,
         DSiGetWindowsVersion, DSiRebuildDesktopIcons.
       - Added TDSiRegistry methods ReadStrings and WriteStrings dealing with MULTI_SZ
         registry format.
     1.06a: 2003-09-03
       - Typo fixed in DSiMsgWaitForTwoObjectsEx.
     1.06: 2003-09-02
       - New functions: DSiMsgWaitForTwoObjectsEx, DSiMsgWaitForThreeObjectsEx.
       - Documented 'Handles' and 'Registry' sections.
       - Bug fixed in DSiLoadLibrary.
     1.05: 2003-09-02
       - New functions: DSiMonitorOn, DSiMonitorOff, DSiMonitorStandby, DSiGetBootType,
         DSiShareFolder, DSiUnshareFolder, DSiFileSize, DSiEnumFiles, DSiEnumFilesEx,
         DSiGetDomain, DSiProcessMessages, DSiProcessThreadMessages, DSiLoadLibrary,
         DSiGetProcAddress, DSiDisableX, DSiEnableX.
       - Added dynamically loaded API forwarders: DSiNetApiBufferFree, DSiNetWkstaGetInfo,
         DSiSHEmptyRecycleBin, DSiCreateProcessAsUser, DSiLogonUser,
         DSiImpersonateLoggedOnUser, DSiRevertToSelf, DSiCloseServiceHandle,
         DSiOpenSCManager, DSi9xNetShareAdd, DSi9xNetShareDel, DSiNTNetShareAdd,
         DSiNTNetShareDel.
       - DSiGetUserName could fail on Win9x. Fixed.
       - Declared constants WAIT_OBJECT_1 (= WAIT_OBJECT_0+1) to WAIT_OBJECT_9
         (=WAIT_OBJECT_0+9).
       - All dynamically loaded functions are now available to the public (see new
         { DynaLoad } section).
       - All functions using dynamically loaded API calls were modified to use new
         DynaLoad methods.
       - All string parameters turned into 'const' parameters.
       - Various constants and type declarations moved to the 'interface' section.
     1.04: 2003-05-27
       - New functions: DSiLoadMedia, DSiEjectMedia.
     1.03: 2003-05-24
       - New functions: DSiExecuteAndCapture, DSiFreeMemAndNil.
     1.02a: 2003-05-05
       - Refuses to compile with Kylix.
       - Removed platform-related warnings on Delphi 6&7.
     1.02: 2002-12-29
       - New function: DSiElapsedSince.
     1.01: 2002-12-19
       - Compiles with Delphi 6 and Delphi 7.
       - New functions:
          Files:
            procedure DSiDeleteFiles(folder: string; fileMask: string);
            procedure DSiDeleteTree(folder: string; removeSubdirsOnly: boolean);
            procedure DSiEmptyFolder(folder: string);
            procedure DSiEmptyRecycleBin;
            procedure DSiRemoveFolder(folder: string);
            procedure DSiuSecDelay(delay: word);
          Processes:
            function  DSiExecuteAsUser(const commandLine, username, password: string;
              const domain: string = '.'; visibility: integer = SW_SHOWDEFAULT;
              workDir: string = ''; wait: boolean = false): cardinal;
            function  DSiImpersonateUser(const username, password, domain: string): boolean;
            procedure DSiStopImpersonatingUser;
     1.0: 2002-11-25
       - Released.
*)

unit DSiWin32;

{$J+,T-}// required!

interface

{$IFDEF Linux}{$MESSAGE FATAL 'This unit is for Windows only'}{$ENDIF Linux}
{$IFDEF OSX}{$MESSAGE FATAL 'This unit is for Windows only'}{$ENDIF OSX}
{$IFDEF MSWindows}{$WARN SYMBOL_PLATFORM OFF}{$WARN UNIT_PLATFORM OFF}{$ENDIF MSWindows}

{$DEFINE NeedUTF}{$UNDEF NeedVariants}{$DEFINE NeedStartupInfo}
{$DEFINE NeedFileCtrl}
{$DEFINE NeedRawByteString}
{$IFDEF ConditionalExpressions}
  {$UNDEF NeedUTF}{$DEFINE NeedVariants}{$UNDEF NeedStartupInfo}
  {$IF RTLVersion >= 18}{$UNDEF NeedFileCtrl}{$IFEND}
  {$IF CompilerVersion >= 23}{$DEFINE ScopedUnitNames}{$IFEND}
{$ENDIF}
{$IFDEF Unicode}{$UNDEF NeedRawByteString}{$ENDIF}

uses
  {$IFDEF ScopedUnitNames}Winapi.Windows{$ELSE}Windows{$ENDIF},
  {$IFDEF ScopedUnitNames}Winapi.Messages{$ELSE}Messages{$ENDIF},
  {$IFDEF NeedVariants}
  {$IFDEF ScopedUnitNames}System.Variants{$ELSE}Variants{$ENDIF},
  {$ENDIF}
  {$IFDEF NeedFileCtrl}
  FileCtrl, // use before SysUtils so deprecated functions from FileCtrl can be reintroduced
  {$ENDIF NeedFileCtrl}
  {$IFDEF ScopedUnitNames}
  System.UITypes,
  {$ENDIF}
  {$IFDEF ScopedUnitNames}System.SysUtils{$ELSE}SysUtils{$ENDIF},
  {$IFDEF ScopedUnitNames}Winapi.ShellAPI{$ELSE}ShellAPI{$ENDIF},
  {$IFDEF ScopedUnitNames}Winapi.ShlObj{$ELSE}ShlObj{$ENDIF},
  {$IFDEF ScopedUnitNames}System.Classes{$ELSE}Classes{$ENDIF},
  {$IFDEF ScopedUnitNames}Vcl.Graphics{$ELSE}Graphics{$ENDIF},
  {$IFDEF ScopedUnitNames}System.Win.Registry{$ELSE}Registry{$ENDIF};

const
  // pretty wrappers
  WAIT_OBJECT_1 = WAIT_OBJECT_0 + 1;
  WAIT_OBJECT_2 = WAIT_OBJECT_0 + 2;
  WAIT_OBJECT_3 = WAIT_OBJECT_0 + 3;
  WAIT_OBJECT_4 = WAIT_OBJECT_0 + 4;
  WAIT_OBJECT_5 = WAIT_OBJECT_0 + 5;
  WAIT_OBJECT_6 = WAIT_OBJECT_0 + 6;
  WAIT_OBJECT_7 = WAIT_OBJECT_0 + 7;
  WAIT_OBJECT_8 = WAIT_OBJECT_0 + 8;
  WAIT_OBJECT_9 = WAIT_OBJECT_0 + 9;

  // folder constants missing from ShellObj
  CSIDL_ADMINTOOLS = $0030;
  //v5.0; <user name>\Start Menu\Programs\Administrative Tools
  CSIDL_ALTSTARTUP = $001D;
  //The file system directory that corresponds to the user's nonlocalized Startup program group.
  CSIDL_APPDATA = $001A; //v4.71; Application Data, new for NT4
  CSIDL_CDBURN_AREA = $003B;
  //v6.0; The file system directory acting as a staging area for files waiting to be written to CD.
  CSIDL_COMMON_ADMINTOOLS = $002F;
  //v5.0; All Users\Start Menu\Programs\Administrative Tools
  CSIDL_COMMON_ALTSTARTUP = $001E;
  //The file system directory that corresponds to the nonlocalized Startup program group for all users.
  CSIDL_COMMON_APPDATA = $0023; //v5.0; All Users\Application Data
  CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
  //The file system directory that contains files and folders that appear on the desktop for all users.
  CSIDL_COMMON_DOCUMENTS = $002E; //All Users\Documents
  CSIDL_COMMON_FAVORITES = $001F;
  //The file system directory that serves as a common repository for favorite items common to all users.
  CSIDL_COMMON_MUSIC = $0035;
  //v6.0; The file system directory that serves as a repository for music files common to all users.
  CSIDL_COMMON_PICTURES = $0036;
  //v6.0; The file system directory that serves as a repository for image files common to all users.
  CSIDL_COMMON_PROGRAMS = $0017;
  //The file system directory that contains the directories for the common program groups that appear on the Start menu for all users.
  CSIDL_COMMON_STARTMENU = $0016;
  //The file system directory that contains the programs and folders that appear on the Start menu for all users.
  CSIDL_COMMON_STARTUP = $0018;
  //The file system directory that contains the programs that appear in the Startup folder for all users.
  CSIDL_COMMON_TEMPLATES = $002D;
  //The file system directory that contains the templates that are available to all users.
  CSIDL_COMMON_VIDEO = $0037;
  //v6.0; The file system directory that serves as a repository for video files common to all users.
  CSIDL_COMPUTERSNEARME = $003D;
  //The folder representing other machines in your workgroup.
  CSIDL_CONNECTIONS = $0031;
  //The virtual folder representing Network Connections, containing network and dial-up connections.
  CSIDL_COOKIES = $0021;
  //The file system directory that serves as a common repository for Internet cookies.
  CSIDL_HISTORY = $0022;
  //The file system directory that serves as a common repository for Internet history items.
  CSIDL_INTERNET = $0001;
  //A viritual folder for Internet Explorer (icon on desktop).
  CSIDL_INTERNET_CACHE = $0020;
  //v4.72; The file system directory that serves as a common repository for temporary Internet files.
  CSIDL_LOCAL_APPDATA = $001C;
  //v5.0; non roaming, user\Local Settings\Application Data
  CSIDL_MYDOCUMENTS = $000C;
  //v6.0; The virtual folder representing the My Documents desktop item.
  CSIDL_MYMUSIC = $000D;
  //The file system directory that serves as a common repository for music files.
  CSIDL_MYPICTURES = $0027; //v5.0; My Pictures, new for Win2K
  CSIDL_MYVIDEO = $000E;
  //v6.0; The file system directory that serves as a common repository for video files.
  CSIDL_PHOTOALBUMS = $0045;
  //Vista; The virtual folder used to store photo albums.
  CSIDL_PLAYLISTS = $003F;
  //Vista; The virtual folder used to store play albums.
  CSIDL_PRINTHOOD = $001B;
  //The file system directory that contains the link objects that can exist in the Printers virtual folder.
  CSIDL_PROFILE = $0028;              //v5.0; The user's profile folder.
  CSIDL_PROGRAM_FILES = $0026;        //v5.0; C:\Program Files
  CSIDL_PROGRAM_FILES_COMMON = $002B; //v5.0; C:\Program Files\Common
  CSIDL_RESOURCES = $0038;
  //Vista; The file system directory that contains resource data.
  CSIDL_SAMPLE_MUSIC = $0040;
  //Vista; The file system directory that contains sample music.
  CSIDL_SAMPLE_PICTURES = $0042;
  //Vista; The file system directory that contains sample pictures.
  CSIDL_SAMPLE_PLAYLISTS = $0041;
  //Vista; The file system directory that contains sample playlists.
  CSIDL_SAMPLE_VIDEOS = $0043;
  //Vista; The file system directory that contains sample videos.
  CSIDL_SYSTEM  = $0025; //v5.0; GetSystemDirectory()
  CSIDL_WINDOWS = $0024; //GetWindowsDirectory()

  CSIDL_FLAG_DONT_UNEXPAND = $2000;
  //Combine with another CSIDL constant to ensure expanding of environment variables.
  CSIDL_FLAG_DONT_VERIFY   = $4000;
  //Combine with another CSIDL constant, except for CSIDL_FLAG_CREATE, to return an unverified folder path-with no attempt to create or initialize the folder.
  CSIDL_FLAG_CREATE        = $8000;
  // new for Win2K, OR this in to force creation of folder

  FILE_DEVICE_FILE_SYSTEM   = 9;
  FILE_DEVICE_MASS_STORAGE  = $2D;
  METHOD_BUFFERED           = 0;
  FILE_ANY_ACCESS           = 0;
  FILE_READ_ACCESS          = 1;
  FILE_WRITE_ACCESS         = 2;
  IOCTL_STORAGE_EJECT_MEDIA = (FILE_DEVICE_MASS_STORAGE shl 16) or
    (FILE_READ_ACCESS shl 14) or ($202 shl 2) or (METHOD_BUFFERED);
  IOCTL_STORAGE_LOAD_MEDIA  = (FILE_DEVICE_MASS_STORAGE shl 16) or
    (FILE_READ_ACCESS shl 14) or ($203 shl 2) or (METHOD_BUFFERED);
  FSCTL_SET_COMPRESSION     =
    (FILE_DEVICE_FILE_SYSTEM shl 16) or
    ((FILE_READ_ACCESS or FILE_WRITE_ACCESS) shl 14) or (16 shl 2) or
    (METHOD_BUFFERED);

  COMPRESSION_FORMAT_NONE    = 0;
  COMPRESSION_FORMAT_DEFAULT = 1;

  SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;

  STYPE_DISKTREE    = 0;
  SHI50F_RDONLY     = $0001;
  SHI50F_FULL       = $0002;
  SHI50F_DEPENDSON  = SHI50F_RDONLY or SHI50F_FULL;
  SHI50F_ACCESSMASK = SHI50F_RDONLY or SHI50F_FULL;

  // IPersisteFile GUID
  IID_IPersistFile: TGUID = (
    D1: $0000010B; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));

  // Extension for shortcut files
  CLinkExt = '.lnk';

  // ShEmptyRecycleBinA flags
  SHERB_NOCONFIRMATION = $00000001;
  SHERB_NOPROGRESSUI   = $00000002;
  SHERB_NOSOUND        = $00000004;

  // CurrentVersion registry key
  DSiWinVerKey9x = '\Software\Microsoft\Windows\CurrentVersion';
  DSiWinVerKeyNT = '\Software\Microsoft\Windows NT\CurrentVersion';
  DSiWinVerKeys: array [boolean] of string = (DSiWinVerKey9x, DSiWinVerKeyNT);

  // CPU IDs for the Affinity familiy of functions
  DSiCPUIDs = '0123456789ABCDEFGHIJKLMNOPQRSTUV';

  // security constants needed in DSiIsAdmin
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;
  DOMAIN_ALIAS_RID_USERS: DWORD = $00000221;
  DOMAIN_ALIAS_RID_GUESTS: DWORD = $00000222;
  DOMAIN_ALIAS_RID_POWER_: DWORD = $00000223;
  SE_GROUP_ENABLED = $00000004;

type
  // API types not defined in Delphi 5
  PWkstaInfo100 = ^TWkstaInfo100;

  _WKSTA_INFO_100 = record
    wki100_platform_id:  DWORD;
    wki100_computername: LPWSTR;
    wki100_langroup:     LPWSTR;
    wki100_ver_major:    DWORD;
    wki100_ver_minor:    DWORD;
  end;
  {$EXTERNALSYM _WKSTA_INFO_100}
  TWkstaInfo100  = _WKSTA_INFO_100;
  WKSTA_INFO_100 = _WKSTA_INFO_100;
  {$EXTERNALSYM WKSTA_INFO_100}

  SHARE_INFO_2_NT = record
    shi2_netname:      PWideChar;
    shi2_type:         integer;
    shi2_remark:       PWideChar;
    shi2_permissions:  integer;
    shi2_max_uses:     integer;
    shi2_current_uses: integer;
    shi2_path:         PWideChar;
    shi2_passwd:       PWideChar;
  end;

  SHARE_INFO_50_9x = record
    shi50_netname:     array[1..13] of char;
    shi50_type:        byte;
    shi50_flags:       short;
    shi50_remark:      PChar;
    shi50_path:        PChar;
    shi50_rw_password: array[1..9] of char;
    shi50_ro_password: array[1..9] of char;
    szWhatever:        array[1..256] of char;
  end;

  _PROCESS_MEMORY_COUNTERS = packed record
    cb: DWORD;
    PageFaultCount: DWORD;
    PeakWorkingSetSize: DWORD;
    WorkingSetSize: DWORD;
    QuotaPeakPagedPoolUsage: DWORD;
    QuotaPagedPoolUsage: DWORD;
    QuotaPeakNonPagedPoolUsage: DWORD;
    QuotaNonPagedPoolUsage: DWORD;
    PagefileUsage: DWORD;
    PeakPagefileUsage: DWORD;
  end;
  PROCESS_MEMORY_COUNTERS  = _PROCESS_MEMORY_COUNTERS;
  PPROCESS_MEMORY_COUNTERS = ^_PROCESS_MEMORY_COUNTERS;
  TProcessMemoryCounters   = _PROCESS_MEMORY_COUNTERS;
  PProcessMemoryCounters   = ^_PROCESS_MEMORY_COUNTERS;

  DWORDLONG = int64;

  PMemoryStatusEx = ^TMemoryStatusEx;

  _MEMORYSTATUSEX = record
    dwLength:         DWORD;
    dwMemoryLoad:     DWORD;
    ullTotalPhys:     DWORDLONG;
    ullAvailPhys:     DWORDLONG;
    ullTotalPageFile: DWORDLONG;
    ullAvailPageFile: DWORDLONG;
    ullTotalVirtual:  DWORDLONG;
    ullAvailVirtual:  DWORDLONG;
    ullAvailExtendedVirtual: DWORDLONG;
  end;
  TMemoryStatusEx = _MEMORYSTATUSEX;
  MEMORYSTATUSEX  = _MEMORYSTATUSEX;

  // Service Controller handle
  SC_HANDLE = THandle;

  // DSiEnumFiles callback
  TDSiEnumFilesCallback   = procedure(const longFileName: string) of object;
  // DSiEnumFilesEx callback
  TDSiEnumFilesExCallback = procedure(const folder: string; S: TSearchRec;
    isAFolder: boolean; var stopEnum: boolean) of object;

  // DSiExecuteAndCapture callback
  TDSiOnNewLineCallback = procedure(const line: string;
    var runningTimeLeft_sec: integer) of object;

  TDSiFileTime = (ftCreation, ftLastAccess, ftLastModification);

  { Handles }

  // Pretty-print aliases
  TDSiFileHandle      = THandle;
  TDSiPipeHandle      = THandle;
  TDSiMutexHandle     = THandle;
  TDSiEventHandle     = THandle;
  TDSiSemaphoreHandle = THandle;

procedure DSiCloseHandleAndInvalidate(var handle: THandle);
procedure DSiCloseHandleAndNull(var handle: THandle);
function DSiMsgWaitForThreeObjectsEx(obj0, obj1, obj2: THandle;
  timeout: DWORD; wakeMask: DWORD; flags: DWORD): DWORD;
function DSiMsgWaitForTwoObjectsEx(obj0, obj1: THandle; timeout: DWORD;
  wakeMask: DWORD; flags: DWORD): DWORD;
function DSiWaitForThreeObjects(obj0, obj1, obj2: THandle; waitAll: boolean;
  timeout: DWORD): DWORD;
function DSiWaitForThreeObjectsEx(obj0, obj1, obj2: THandle;
  waitAll: boolean; timeout: DWORD; alertable: boolean): DWORD;
function DSiWaitForTwoObjects(obj0, obj1: THandle; waitAll: boolean;
  timeout: DWORD): DWORD;
function DSiWaitForTwoObjectsEx(obj0, obj1: THandle; waitAll: boolean;
  timeout: DWORD; alertable: boolean): DWORD;
function DSiWin32CheckHandle(handle: THandle): THandle;
function DSiWin32CheckNullHandle(handle: THandle): THandle;

{ Registry }

const
  KEY_WOW64_64KEY = $0100;

type
  {$IFDEF NeedRawByteString}
  RawByteString = AnsiString;
  {$ENDIF NeedRawByteString}

  TDSiRegistry = class(TRegistry)
  public
    function ReadBinary(const Name: string; const defval: RawByteString): RawByteString;
      overload;
    function ReadBinary(const Name: string; dataStream: TStream): boolean; overload;
    function ReadBool(const Name: string; defval: boolean): boolean;
    function ReadDate(const Name: string; defval: TDateTime): TDateTime;
    function ReadFont(const Name: string; font: TFont): boolean;
    function ReadInt64(const Name: string; defval: int64): int64;
    function ReadInteger(const Name: string; defval: integer): integer;
    function ReadString(const Name, defval: string): string;
    procedure ReadStrings(const Name: string; strings: TStrings);
    function ReadVariant(const Name: string; defval: variant): variant;
    procedure WriteBinary(const Name: string; Data: RawByteString); overload;
    procedure WriteBinary(const Name: string; Data: TStream); overload;
    procedure WriteFont(const Name: string; font: TFont);
    procedure WriteInt64(const Name: string; Value: int64);
    procedure WriteStrings(const Name: string; strings: TStrings);
    procedure WriteVariant(const Name: string; Value: variant);
  end; { TDSiRegistry }

function DSiCreateRegistryKey(const registryKey: string;
  root: HKEY = HKEY_CURRENT_USER): boolean;
function DSiDeleteRegistryValue(const registryKey, Name: string;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_SET_VALUE): boolean;
function DSiKillRegistry(const registryKey: string; root: HKEY = HKEY_CURRENT_USER;
  access: longword = KEY_SET_VALUE): boolean;
function DSiReadRegistry(const registryKey, Name: string; defaultValue: variant;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_QUERY_VALUE): variant; overload;
function DSiReadRegistry(const registryKey, Name: string; defaultValue: int64;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_QUERY_VALUE): int64; overload;
function DSiRegistryKeyExists(const registryKey: string;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_QUERY_VALUE): boolean;
function DSiRegistryValueExists(const registryKey, Name: string;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_QUERY_VALUE): boolean;
function DSiWriteRegistry(const registryKey, Name: string; Value: int64;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_SET_VALUE): boolean; overload;
function DSiWriteRegistry(const registryKey, Name: string; Value: variant;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_SET_VALUE): boolean; overload;

{ Files }

type
  TShFileOpFlag  = (fofAllowUndo, fofFilesOnly, fofMultiDestFiles, fofNoConfirmation,
    fofNoConfirmMkDir, fofNoConnectedElements, fofNoErrorUI, fofNoRecursion,
    fofNoRecurseReparse, fofRenameOnCollision, fofSilent, fofSimpleProgress,
    fofWantMappingHandle, fofWantNukeWarning, fofNoUI);
  TShFileOpFlags = set of TShFileOpFlag;

const
  FILE_LIST_DIRECTORY = $0001;
  FILE_SHARE_FULL     = FILE_SHARE_DELETE or FILE_SHARE_READ or FILE_SHARE_WRITE;

  FILE_ACTION_ADDED    = $00000001;
  FILE_ACTION_REMOVED  = $00000002;
  FILE_ACTION_MODIFIED = $00000003;
  FILE_ACTION_RENAMED_OLD_NAME = $00000004;
  FILE_ACTION_RENAMED_NEW_NAME = $00000005;

  FOF_NOCONNECTEDELEMENTS = $2000;
  FOF_NORECURSION = $1000;
  FOF_NORECURSEREPARSE = $8000;
  FOF_WANTNUKEWARNING = $4000;
  FOF_NO_UI = FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR;

  CShFileOpFlagMappings: array [TShFileOpFlag] of FILEOP_FLAGS = (FOF_ALLOWUNDO,
    FOF_FILESONLY, FOF_MULTIDESTFILES, FOF_NOCONFIRMATION, FOF_NOCONFIRMMKDIR,
    FOF_NOCONNECTEDELEMENTS, FOF_NOERRORUI, FOF_NORECURSION, FOF_NORECURSEREPARSE,
    FOF_RENAMEONCOLLISION, FOF_SILENT, FOF_SIMPLEPROGRESS, FOF_WANTMAPPINGHANDLE,
    FOF_WANTNUKEWARNING, FOF_NO_UI);

function DSiCanWriteToFolder(const folderName: string): boolean;
function DSiCompressFile(fileHandle: THandle): boolean;
function DSiConnectToNetworkResource(const networkResource: string;
  const mappedLetter: string = ''; const username: string = '';
  const password: string = ''): boolean;
function DSiCopyFileAnimated(ownerWindowHandle: THandle;
  sourceFile, destinationFile: string; var aborted: boolean;
  flags: TShFileOpFlags = [fofNoConfirmMkDir]): boolean;
function DSiCreateTempFolder: string;
procedure DSiDeleteFiles(const folder, fileMask: string);
function DSiDeleteOnReboot(const fileName: string): boolean;
procedure DSiDeleteTree(const folder: string; removeSubdirsOnly: boolean);
function DSiDeleteWithBatch(const fileName: string; rmDir: boolean = False): boolean;
function DSiDirectoryExistsW(const directory: WideString): boolean;
function DSiDisableWow64FsRedirection(var oldStatus: pointer): boolean;
function DSiDisconnectFromNetworkResource(mappedLetter: char;
  updateProfile: boolean = False): boolean;
function DSiEjectMedia(deviceLetter: char): boolean;
procedure DSiEmptyFolder(const folder: string);
function DSiEmptyRecycleBin: boolean;
function DSiEnumFiles(const fileMask: string; attr: integer;
  enumCallback: TDSiEnumFilesCallback): integer;
function DSiEnumFilesEx(const fileMask: string; attr: integer;
  enumSubfolders: boolean; enumCallback: TDSiEnumFilesExCallback;
  maxEnumDepth: integer = 0): integer;
procedure DSiEnumFilesToSL(const fileMask: string; attr: integer;
  fileList: TStrings; storeFullPath: boolean = False; enumSubfolders: boolean = False;
  maxEnumDepth: integer = 0);
function DSiFileExistsW(const fileName: WideString): boolean;
function DSiFileExtensionIs(const fileName, extension: string): boolean; overload;
function DSiFileExtensionIs(const fileName: string;
  extension: array of string): boolean;
  overload;
function DSiFileSize(const fileName: string): int64;
function DSiFileSizeW(const fileName: WideString): int64;
function DSiGetFolderSize(const folder: string; includeSubfolders: boolean): int64;
function DSiGetFileTime(const fileName: string; whatTime: TDSiFileTime): TDateTime;
function DSiGetFileTimes(const fileName: string;
  var creationTime, lastAccessTime, lastModificationTime: TDateTime): boolean;
function DSiGetLongPathName(const fileName: string): string;
function DSiGetNetworkResource(mappedLetter: char; var networkResource: string;
  var connectionIsAvailable: boolean): boolean;
function DSiGetSubstDrive(mappedLetter: char): string;
function DSiGetSubstPath(const path: string): string;
function DSiGetTempFileName(const prefix: string; const tempPath: string = ''): string;
function DSiGetTempPath: string;
function DSiGetUniqueFileName(const extension: string): string;
function DSiIsFileCompressed(const fileName: string): boolean;
function DSiIsFileCompressedW(const fileName: WideString): boolean;
function DSiKillFile(const fileName: string): boolean;
function DSiLoadMedia(deviceLetter: char): boolean;
function DSiMoveFile(const srcName, destName: string;
  overwrite: boolean = True): boolean;
function DSiMoveOnReboot(const srcName, destName: string): boolean;
procedure DSiRemoveFolder(const folder: string);
function DSiRevertWow64FsRedirection(const oldStatus: pointer): boolean;
function DSiSetFileTime(const fileName: string; dateTime: TDateTime;
  whatTime: TDSiFileTime): boolean;
function DSiSetFileTimes(const fileName: string;
  creationTime, lastAccessTime, lastModificationTime: TDateTime): boolean;
function DSiShareFolder(const folder, shareName, comment: string): boolean;
function DSiUncompressFile(fileHandle: THandle): boolean;
function DSiUnShareFolder(const shareName: string): boolean;

{ Processes }

function DSiAddAceToDesktop(desktop: HDESK; sid: PSID): boolean;
function DSiAddAceToWindowStation(station: HWINSTA; sid: PSID): boolean;
function DSiAffinityMaskToString(affinityMask: DWORD): string;
function DSiGetCurrentProcessHandle: THandle;
function DSiGetCurrentThreadHandle: THandle;
function DSiEnablePrivilege(const privilegeName: string): boolean;
function DSiExecute(const commandLine: string; visibility: integer = SW_SHOWDEFAULT;
  const workDir: string = ''; wait: boolean = False): cardinal;
function DSiExecuteAndCapture(const app: string; output: TStrings;
  const workDir: string; var exitCode: longword; waitTimeout_sec: integer = 15;
  onNewLine: TDSiOnNewLineCallback = nil): cardinal;
function DSiExecuteAsUser(const commandLine, username, password: string;
  var winErrorCode: cardinal; const domain: string = '.';
  visibility: integer = SW_SHOWDEFAULT; const workDir: string = '';
  wait: boolean = False): cardinal; overload;
function DSiExecuteAsUser(const commandLine, username, password: string;
  var winErrorCode: cardinal; var processInfo: TProcessInformation;
  const domain: string = '.'; visibility: integer = SW_SHOWDEFAULT;
  const workDir: string = ''; wait: boolean = False;
  startInfo: PStartupInfo = nil): cardinal; overload;
function DSiGetProcessAffinity: string;
function DSiGetProcessAffinityMask: DWORD;
function DSiGetProcessID(const processName: string; var processID: DWORD): boolean;
function DSiGetProcessMemory(var memoryCounters: TProcessMemoryCounters): boolean;
  overload;
function DSiGetProcessMemory(process: THandle;
  var memoryCounters: TProcessMemoryCounters): boolean; overload;
function DSiGetProcessFileName(process: THandle; var processName: string): boolean;
function DSiGetProcessOwnerInfo(const processName: string;
  var user, domain: string): boolean; overload;
function DSiGetProcessOwnerInfo(processID: DWORD; var user, domain: string): boolean;
  overload;
function DSiGetProcessTimes(var creationTime: TDateTime;
  var userTime, kernelTime: int64): boolean; overload;
function DSiGetProcessTimes(process: THandle; var creationTime, exitTime: TDateTime;
  var userTime, kernelTime: int64): boolean; overload;
function DSiGetSystemAffinity: string;
function DSiGetSystemAffinityMask: DWORD;
function DSiGetThreadAffinity: string;
function DSiGetThreadAffinityMask: DWORD;
function DSiGetThreadTime: int64; overload;
function DSiGetThreadTime(thread: THandle): int64; overload;
function DSiGetThreadTimes(var creationTime: TDateTime;
  var userTime, kernelTime: int64): boolean; overload;
function DSiGetThreadTimes(thread: THandle; var creationTime, exitTime: TDateTime;
  var userTime, kernelTime: int64): boolean; overload;
function DSiImpersonateUser(const username, password: string;
  const domain: string = '.'): boolean;
function DSiIncrementWorkingSet(incMinSize, incMaxSize: integer): boolean;
function DSiIsDebugged: boolean;
function DSiLogonAs(const username, password: string;
  var logonHandle: THandle): boolean;
  overload;
function DSiLogonAs(const username, password, domain: string;
  var logonHandle: THandle): boolean; overload;
function DSiOpenURL(const URL: string; newBrowser: boolean = False): boolean;
procedure DSiProcessThreadMessages;
function DSiRealModuleName: string;
function DSiRemoveAceFromDesktop(desktop: HDESK; sid: PSID): boolean;
function DSiRemoveAceFromWindowStation(station: HWINSTA; sid: PSID): boolean;
function DSiSetProcessAffinity(affinity: string): string;
function DSiSetProcessPriorityClass(const processName: string;
  priority: DWORD): boolean;
function DSiSetThreadAffinity(affinity: string): string;
procedure DSiStopImpersonatingUser;
function DSiStringToAffinityMask(affinity: string): DWORD;
function DSiTerminateProcessById(processID: DWORD; closeWindowsFirst: boolean = True;
  maxWait_sec: integer = 10): boolean;
procedure DSiTrimWorkingSet;
function DSiValidateProcessAffinity(affinity: string): string;
function DSiValidateProcessAffinityMask(affinityMask: DWORD): DWORD;
function DSiValidateThreadAffinity(affinity: string): string;
function DSiValidateThreadAffinityMask(affinityMask: DWORD): DWORD;
procedure DSiYield;

{ Memory }

procedure DSiFreePidl(pidl: PItemIDList);
procedure DSiFreeMemAndNil(var mem: pointer);
function DSiGetGlobalMemoryStatus(var memoryStatus: TMemoryStatusEx): boolean;

{ Windows }

type
  TDSiExitWindows = (ewLogOff, ewForcedLogOff, ewPowerOff, ewForcedPowerOff, ewReboot,
    ewForcedReboot, ewShutdown, ewForcedShutdown);

function DSiAllocateHWnd(wndProcMethod: TWndMethod): HWND;
procedure DSiDeallocateHWnd(wnd: HWND);
function DSiDisableStandby: boolean;
procedure DSiDisableX(hwnd: THandle);
procedure DSiEnableX(hwnd: THandle);
function DSiExitWindows(exitType: TDSiExitWindows): boolean;
function DSiForceForegroundWindow(hwnd: THandle; restoreFirst: boolean = True): boolean;
function DSiGetClassName(hwnd: THandle): string;
function DSiGetProcessWindow(targetProcessID: cardinal): HWND;
function DSiGetWindowText(hwnd: THandle): string;
procedure DSiProcessMessages(hwnd: THandle; waitForWMQuit: boolean = False);
procedure DSiRebuildDesktopIcons;
procedure DSiRefreshDesktop;
procedure DSiSetTopMost(hwnd: THandle; onTop: boolean = True;
  activate: boolean = False);

{ Aero }

function DSiAeroDisable: boolean;
function DSiAeroEnable: boolean;
function DSiAeroIsEnabled: boolean;

{ Taskbar }

function DSiGetTaskBarPosition: integer;

{ Menus }

function DSiGetHotkey(const item: string): char;
function DSiGetMenuItem(menu: HMENU; item: integer): string;

{ Screen }

procedure DSiDisableScreenSaver(out currentlyActive: boolean);
procedure DSiEnableScreenSaver;
function DSiGetBitsPerPixel: integer;
function DSiGetBPP: integer;
function DSiGetDesktopSize: TRect;
function DSiIsFullScreen: boolean;
procedure DSiMonitorOff;
procedure DSiMonitorOn;
procedure DSiMonitorStandby;
function DSiSetScreenResolution(Width, Height: integer): longint;

{ Rectangles }

procedure DSiCenterRectInRect(const ownerRect: TRect; var clientRect: TRect);
procedure DSiMakeRectFullyVisibleOnRect(const ownerRect: TRect; var clientRect: TRect);

{ Clipboard }

function DSiIsHtmlFormatOnClipboard: boolean;
function DSiGetHtmlFormatFromClipboard: string;
procedure DSiCopyHtmlFormatToClipboard(const sHtml: string; const sText: string = '');

{ Information }

type
  TDSiBootType       = (btNormal, btFailSafe, btFailSafeWithNetwork, btUnknown);
  TDSiWindowsVersion = (wvUnknown, wvWin31, wvWin95, wvWin95OSR2, wvWin98,
    wvWin98SE, wvWinME, wvWin9x, wvWinNT3, wvWinNT4, wvWin2000, wvWinXP,
    wvWinNT, wvWinServer2003, wvWinVista, wvWinServer2008, wvWinServer2008OrVistaSP1,
    wvWin7, wvWinServer2008R2, wvWin7OrServer2008R2);

  TDSiUIElement = (ueMenu, ueMessage, ueWindowCaption, ueStatus);

const
  CDSiWindowsVersionStr: array [TDSiWindowsVersion] of string = ('Unknown',
    'Windows 3.1', 'Windows 95', 'Windows 95 OSR 2', 'Windows 98',
    'Windows 98 SE', 'Windows Me', 'Windows 9x', 'Windows NT 3.5',
    'Windows NT 4', 'Windows 2000', 'Windows XP', 'Windows NT', 'Windows Server 2003',
    'Windows Vista', 'Windows Server 2008', 'Windows Server 2008 or Windows Vista SP1',
    'Windows 7', 'Windows Server 2008 R2', 'Windows 7 or Windows Server 2008 R2');

  VER_SUITE_BACKOFFICE     = $00000004; // Microsoft BackOffice components are installed.
  VER_SUITE_BLADE          = $00000400; // Windows Server 2003, Web Edition is installed.
  VER_SUITE_COMPUTE_SERVER = $00004000;
  // Windows Server 2003, Compute Cluster Edition is installed.
  VER_SUITE_DATACENTER     = $00000080;
  // Windows Server 2008 Datacenter, Windows Server 2003, Datacenter Edition, or Windows 2000 Datacenter Server is installed.
  VER_SUITE_ENTERPRISE     = $00000002;
  // Windows Server 2008 Enterprise, Windows Server 2003, Enterprise Edition, or Windows 2000 Advanced Server is installed. Refer to the Remarks section for more information about this bit flag.
  VER_SUITE_EMBEDDEDNT     = $00000040; // Windows XP Embedded is installed.
  VER_SUITE_PERSONAL       = $00000200;
  // Windows Vista Home Premium, Windows Vista Home Basic, or Windows XP Home Edition is installed.
  VER_SUITE_SINGLEUSERTS   = $00000100;
  // Remote Desktop is supported, but only one interactive session is supported. This value is set unless the system is running in application server mode.
  VER_SUITE_SMALLBUSINESS  = $00000001;
  // Microsoft Small Business Server was once installed on the system, but may have been upgraded to another version of Windows. Refer to the Remarks section for more information about this bit flag.
  VER_SUITE_SMALLBUSINESS_RESTRICTED =
    $00000020;
  // Microsoft Small Business Server is installed with the restrictive client license in force. Refer to the Remarks section for more information about this bit flag.
  VER_SUITE_STORAGE_SERVER = $00002000;
  // Windows Storage Server 2003 R2 or Windows Storage Server 2003is installed.
  VER_SUITE_TERMINAL       = $00000010;
  // Terminal Services is installed. This value is always set.
  VER_SUITE_WH_SERVER      = $00008000; // Windows Home Server is installed.

  VER_NT_DOMAIN_CONTROLLER = $0000002;
  // The system is a domain controller and the operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server.
  VER_NT_SERVER      = $0000003;
  // The operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server.
  // Note that a server that is also a domain controller is reported as VER_NT_DOMAIN_CONTROLLER, not VER_NT_SERVER.
  VER_NT_WORKSTATION = $0000001;
// The operating system is Windows Vista, Windows XP Professional, Windows XP Home Edition, or Windows 2000 Professional.

type
  _OSVERSIONINFOEXA = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion:      DWORD;
    dwMinorVersion:      DWORD;
    dwBuildNumber:       DWORD;
    dwPlatformId:        DWORD;
    szCSDVersion:        array[0..127] of AnsiChar;
    { Maintenance AnsiString for PSS usage }
    wServicePackMajor:   word;
    wServicePackMinor:   word;
    wSuiteMask:          word;
    wProductType:        byte;
    wReserved:           byte;
  end;
  {$EXTERNALSYM _OSVERSIONINFOEXA}
  _OSVERSIONINFOEXW = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion:      DWORD;
    dwMinorVersion:      DWORD;
    dwBuildNumber:       DWORD;
    dwPlatformId:        DWORD;
    szCSDVersion:        array[0..127] of widechar;
    { Maintenance WideString for PSS usage }
    wServicePackMajor:   word;
    wServicePackMinor:   word;
    wSuiteMask:          word;
    wProductType:        byte;
    wReserved:           byte;
  end;
  {$EXTERNALSYM _OSVERSIONINFOExW}
  _OSVERSIONINFEXO  = _OSVERSIONINFOEXA;
  TOSVersionInfoExA = _OSVERSIONINFOEXA;
  TOSVersionInfoExW = _OSVERSIONINFOEXW;
  TOSVersionInfoEx  = TOSVersionInfoExA;
  OSVERSIONINFOEXA  = _OSVERSIONINFOEXA;
  {$EXTERNALSYM OSVERSIONINFOEXA}
  {$EXTERNALSYM OSVERSIONINFOEX}
  OSVERSIONINFOEXW  = _OSVERSIONINFOEXW;
  {$EXTERNALSYM OSVERSIONINFOEXW}
  {$EXTERNALSYM OSVERSIONINFOEX}
  OSVERSIONINFOEX   = OSVERSIONINFOEXA;

  {$IFNDEF NeedStartupInfo}
  _STARTUPINFOW = record
    cb:          DWORD;
    lpReserved:  PWideChar;
    lpDesktop:   PWideChar;
    lpTitle:     PWideChar;
    dwX:         DWORD;
    dwY:         DWORD;
    dwXSize:     DWORD;
    dwYSize:     DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags:     DWORD;
    wShowWindow: word;
    cbReserved2: word;
    lpReserved2: PByte;
    hStdInput:   THandle;
    hStdOutput:  THandle;
    hStdError:   THandle;
  end;
  TStartupInfoW = _STARTUPINFOW;
  PStartupInfoW = ^TStartupInfoW;
  TStartupInfoA = TStartupInfo;

  {$ENDIF NeedStartupInfo}

function DSiGetAppCompatFlags(const exeName: string): string;
function DSiGetBootType: TDSiBootType;
function DSiGetCompanyName: string;
function DSiGetComputerName: string;
function DSiGetDefaultBrowser: string;
function DSiGetDirectXVer: string;
function DSiGetDiskLabel(disk: char): string;
function DSiGetDiskSerial(disk: char): string;
function DSiGetDomain: string;
function DSiGetEnvironmentVariable(const envVarName: string): string;
function DSiGetFolderLocation(const CSIDL: integer): string;
procedure DSiGetKeyboardLayouts(layouts: TStrings);
function DSiGetMyDocumentsFolder: string;
function DSiGetProgramFilesFolder: string;
function DSiGetRegisteredOwner: string;
function DSiGetSystemFolder: string;
function DSiGetSystemLanguage: string;
function DSiGetSystemVersion: string;
function DSiGetTrueWindowsVersion: TDSiWindowsVersion;
function DSiGetUserName: string;
function DSiGetUserNameEx: string;
function DSiGetWindowsFolder: string;
function DSiGetWindowsVersion: TDSiWindowsVersion;
function DSiInitFontToSystemDefault(aFont: TFont; aElement: TDSiUIElement): boolean;
function DSiIsAdmin: boolean;
function DSiIsAdminLoggedOn: boolean;
function DSiIsDiskInDrive(disk: char): boolean;
function DSiIsWinNT: boolean;
function DSiIsWow64: boolean;
function DSiVerifyPassword(const username, password: string;
  const domain: string = '.'): boolean;

{ Install }

const // Firewall management constants.
      // NET_FW_IP_PROTOCOL
  NET_FW_IP_PROTOCOL_TCP = 6;
  NET_FW_IP_PROTOCOL_UDP = 17;

  // NET_FW_IP_VERSION
  NET_FW_IP_VERSION_V4  = 0;
  NET_FW_IP_VERSION_V6  = 1;
  NET_FW_IP_VERSION_ANY = 2;

  // NET_FW_POLICY_TYPE
  NET_FW_POLICY_GROUP     = 0;
  NET_FW_POLICY_LOCAL     = 1;
  NET_FW_POLICY_EFFECTIVE = 2;

  // NET_FW_PROFILE_TYPE
  NET_FW_PROFILE_DOMAIN   = 0;
  NET_FW_PROFILE_STANDARD = 1;
  NET_FW_PROFILE_CURRENT  = 2;

  // NET_FW_SCOPE
  NET_FW_SCOPE_ALL          = 0;
  NET_FW_SCOPE_LOCAL_SUBNET = 1;
  NET_FW_SCOPE_CUSTOM       = 2;

  // NET_FW_SERVICE_TYPE 
  NET_FW_SERVICE_FILE_AND_PRINT = 0;
  NET_FW_SERVICE_UPNP           = 1;
  NET_FW_SERVICE_REMOTE_DESKTOP = 2;
  NET_FW_SERVICE_NONE           = 3;

  // NET_FW_ACTION
  NET_FW_ACTION_BLOCK = 0;
  NET_FW_ACTION_ALLOW = 1;

  // NET_FW_EDGE_TRAVERSAL_TYPE
  NET_FW_EDGE_TRAVERSAL_TYPE_DENY          = 0;
  NET_FW_EDGE_TRAVERSAL_TYPE_ALLOW         = 1;
  NET_FW_EDGE_TRAVERSAL_TYPE_DEFER_TO_APP  = 2;
  NET_FW_EDGE_TRAVERSAL_TYPE_DEFER_TO_USER = 3;

  // NET_FW_MODIFY_STATE
  NET_FW_MODIFY_STATE_OK          = 0;
  NET_FW_MODIFY_STATE_GP_OVERRIDE = 1;
  NET_FW_MODIFY_STATE_INBOUND_BLOCKED = 2;

  // NET_FW_PROFILE_TYPE2
  NET_FW_PROFILE2_DOMAIN  = 1;
  NET_FW_PROFILE2_PRIVATE = 2;
  NET_FW_PROFILE2_PUBLIC  = 4;
  NET_FW_PROFILE2_ALL     = $7FFFFFFF;

  // NET_FW_RULE_CATEGORY
  NET_FW_RULE_CATEGORY_BOOT     = 0;
  NET_FW_RULE_CATEGORY_STEALTH  = 1;
  NET_FW_RULE_CATEGORY_FIREWALL = 2;
  NET_FW_RULE_CATEGORY_CONSEC   = 3;
  NET_FW_RULE_CATEGORY_MAX      = 4;

  // NET_FW_RULE_DIRECTION
  NET_FW_RULE_DIR_IN  = 0;
  NET_FW_RULE_DIR_OUT = 1;

type // Firewall management types
  TDSiFwIPProtocol  = (fwProtoTCP, fwProtoUDP);
  TDSiFwIPProtocols = set of TDSiFwIPProtocol;

  TDSiFwIPProfile  = (fwProfileDomain, fwProfilePrivate, fwProfilePublic, fwProfileAll,
    fwProfileCurrent);
  TDSiFwIPProfiles = set of TDSiFwIPProfile;

  TDSiFwResolveConflict = (rcDuplicate, rcOverwrite, rcSkip);

function DSiAddApplicationToFirewallExceptionList(
  const entryName, applicationFullPath: string;
  resolveConflict: TDSiFwResolveConflict = rcDuplicate; description: string = '';
  grouping: string = ''; serviceName: string = '';
  protocols: TDSiFwIPProtocols = [fwProtoTCP]; localPorts: string = '*';
  profiles: TDSiFwIPProfiles = [fwProfileAll]): boolean;
function DSiAddApplicationToFirewallExceptionListAdvanced(
  const entryName, applicationFullPath: string;
  resolveConflict: TDSiFwResolveConflict = rcDuplicate; description: string = '';
  grouping: string = ''; serviceName: string = '';
  protocols: TDSiFwIPProtocols = [fwProtoTCP]; localPorts: string = '*';
  profiles: TDSiFwIPProfiles = [fwProfileAll]): boolean;
function DSiAddApplicationToFirewallExceptionListXP(
  const entryName, applicationFullPath: string;
  resolveConflict: TDSiFwResolveConflict = rcDuplicate;
  profile: TDSiFwIPProfile = fwProfileCurrent): boolean;
function DSiAddPortToFirewallExceptionList(const entryName: string;
  portNumber: cardinal): boolean;
function DSiAddUninstallInfo(
  const displayName, uninstallCommand, publisher, URLInfoAbout,
  displayVersion, helpLink, URLUpdateInfo: string): boolean;
function DSiAutoRunApp(const applicationName, applicationPath: string;
  Enabled: boolean = True): boolean;
procedure DSiCreateShortcut(const fileName, displayName, parameters: string;
  folder: integer = CSIDL_STARTUP; const workDir: string = '');
function DSiDeleteShortcut(const displayName: string;
  folder: integer = CSIDL_STARTUP): boolean;
procedure DSiEditShortcut(const lnkName, fileName, workDir, parameters: string);
function DSiFindApplicationInFirewallExceptionListAdvanced(const entryName: string;
  var rule: olevariant): boolean;
function DSiFindApplicationInFirewallExceptionListXP(const entryName: string;
  var application: olevariant; profile: TDSiFwIPProfile = fwProfileCurrent): boolean;
function DSiGetLogonSID(token: THandle; var logonSID: PSID): boolean;
function DSiGetShortcutInfo(const lnkName: string;
  var fileName, filePath, workDir, parameters: string): boolean;
function DSiGetUninstallInfo(const displayName: string;
  out uninstallCommand: string): boolean;
function DSiIsAutoRunApp(const applicationname: string): boolean;
function DSiRegisterActiveX(const fileName: string; registerDLL: boolean): HRESULT;
procedure DSiRegisterRunOnce(const applicationName, applicationPath: string);
function DSiRemoveApplicationFromFirewallExceptionList(
  const entryName, applicationFullPath: string): boolean;
function DSiRemoveApplicationFromFirewallExceptionListAdvanced(
  const entryName: string): boolean;
function DSiRemoveApplicationFromFirewallExceptionListXP(
  const applicationFullPath: string): boolean; overload;
function DSiRemoveApplicationFromFirewallExceptionListXP(
  const applicationFullPath: string; profile: TDSiFwIPProfile): boolean; overload;
procedure DSiRemoveRunOnce(const applicationName: string);
function DSiRemoveUninstallInfo(const displayName: string): boolean;
function DSiShortcutExists(const displayName: string;
  folder: integer = CSIDL_STARTUP): boolean;

{ Time }

type
  {:TTimer clone that uses DSiAllocateHwnd/DSiDeallocateHwnd instead of Delphi's
    AllocateHwnd/DeallocateHwnd. Intented to be dynamically created in threads and
    therefore not a TComponent descendant.
    @author  gabr
    @since   2007-05-30
  }
  TDSiTimer = class
  private
    dtEnabled:      boolean;
    dtInterval:     cardinal;
    dtOnTimer:      TNotifyEvent;
    dtTag:          longint;
    dtWindowHandle: HWND;
  protected
    procedure SetEnabled(Value: boolean);
    procedure SetInterval(Value: cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure UpdateTimer;
    procedure WndProc(var msgRec: TMessage);
  public
    constructor Create(Enabled: boolean = True; interval: cardinal = 1000;
      onTimer: TNotifyEvent = nil; tag: longint = 0);
    destructor Destroy; override;
    property Enabled: boolean Read dtEnabled Write SetEnabled default True;
    property Interval: cardinal Read dtInterval Write SetInterval default 1000;
    property Tag: longint Read dtTag Write dtTag;
    property OnTimer: TNotifyEvent Read dtOnTimer Write SetOnTimer;
  end; { TDSiTimer }

function DSiDateTimeToFileTime(dateTime: TDateTime; var fileTime: TFileTime): boolean;
//Following three functions are based on GetTickCount
function DSiElapsedSince(midTime, startTime: int64): int64;
function DSiElapsedTime(startTime: int64): int64;
function DSiElapsedTime64(startTime: int64): int64;
function DSiHasElapsed(startTime: int64; timeout_ms: DWORD): boolean;
function DSiHasElapsed64(startTime: int64; timeout_ms: DWORD): boolean;

function DSiFileTimeToDateTime(fileTime: TFileTime): TDateTime; overload;
function DSiFileTimeToDateTime(fileTime: TFileTime; var dateTime: TDateTime): boolean;
  overload;
function DSiFileTimeToMicroSeconds(fileTime: TFileTime): int64;
function DSiPerfCounterToMS(perfCounter: int64): int64;
function DSiPerfCounterToUS(perfCounter: int64): int64;
function DSiQueryPerfCounterAsUS: int64;
function DSiTimeGetTime64: int64;
procedure DSiuSecDelay(delay: int64);

{ Interlocked }

function DSiInterlockedDecrement64(var addend: int64): int64; register;
function DSiInterlockedIncrement64(var addend: int64): int64; register;
function DSiInterlockedExchangeAdd64(var addend: int64; Value: int64): int64; register;
function DSiInterlockedExchange64(var target: int64; Value: int64): int64; register;
function DSiInterlockedCompareExchange64(var destination: int64;
  exchange, comparand: int64): int64; register; overload;
function DSiInterlockedCompareExchange64(destination: PInt64;
  exchange, comparand: int64): int64; register; overload;

{ DynaLoad }

const // composition action values for DSiDwmEnableComposition
  DWM_EC_DISABLECOMPOSITION = 0;
  DWM_EC_ENABLECOMPOSITION  = 1;

type
  PModule = ^HMODULE;

function DSi9xNetShareAdd(serverName: PChar; shareLevel: smallint;
  buffer: pointer; size: word): integer; stdcall;
function DSi9xNetShareDel(serverName: PChar; netName: PChar; reserved: word): integer;
  stdcall;
function DSiCloseServiceHandle(hSCObject: SC_HANDLE): BOOL; stdcall;
function DSiCreateProcessAsUser(hToken: THandle;
  lpApplicationName, lpCommandLine: PChar;
  lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
  bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: pointer;
  lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL; stdcall;
function DSiCreateProcessWithLogonW(lpUsername, lpDomain, lpPassword: PWideChar;
  dwLogonFlags: DWORD; lpApplicationName, lpCommandLine: PWideChar;
  dwCreationFlags: DWORD; lpEnvironment: pointer; lpCurrentDirectory: PWideChar;
  const lpStartupInfo: TStartupInfoW;
  var lpProcessInformation: TProcessInformation): BOOL;
function DSiCreateEnvironmentBlock(var lpEnvironment: pointer;
  hToken: THandle; bInherit: BOOL): BOOL;
function DSiDestroyEnvironmentBlock(lpEnvironment: pointer): BOOL;
function DSiDwmEnableComposition(uCompositionAction: UINT): HRESULT; stdcall;
function DSiDwmIsCompositionEnabled(var pfEnabled: BOOL): HRESULT; stdcall;
function DSiEnumProcessModules(hProcess: THandle; lphModule: PModule;
  cb: DWORD; var lpcbNeeded: DWORD): BOOL; stdcall;
function DSiGetModuleFileNameEx(hProcess: THandle; hModule: HMODULE;
  lpFilename: PChar; nSize: DWORD): DWORD; stdcall;
function DSiGetProcAddress(const libFileName, procName: string): FARPROC;
function DSiGetProcessImageFileName(hProcess: THandle; lpImageFileName: PChar;
  nSize: DWORD): DWORD; stdcall;
function DSiGetProcessMemoryInfo(process: THandle; memCounters: PProcessMemoryCounters;
  cb: DWORD): boolean; stdcall;
function DSiGetTickCount64: int64; stdcall;
function DSiGetUserProfileDirectoryW(hToken: THandle; lpProfileDir: PWideChar;
  var lpcchSize: DWORD): BOOL; stdcall;
function DSiGlobalMemoryStatusEx(memStatus: PMemoryStatusEx): boolean; stdcall;
function DSiImpersonateLoggedOnUser(hToken: THandle): BOOL; stdcall;
function DSiIsWow64Process(hProcess: THandle; var wow64Process: BOOL): BOOL; stdcall;
function DSiLogonUser(lpszUsername, lpszDomain, lpszPassword: PChar;
  dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL; stdcall;
function DSiNetApiBufferFree(buffer: pointer): cardinal; stdcall;
function DSiNetWkstaGetInfo(servername: PChar; level: cardinal;
  out bufptr: pointer): cardinal; stdcall;
function DSiNTNetShareAdd(serverName: PChar; level: integer; buf: PChar;
  var parm_err: integer): DWord; stdcall;
function DSiNTNetShareDel(serverName: PChar; netName: PWideChar;
  reserved: integer): DWord; stdcall;
function DSiOpenSCManager(lpMachineName, lpDatabaseName: PChar;
  dwDesiredAccess: DWORD): SC_HANDLE; stdcall;
function DSiRevertToSelf: BOOL; stdcall;
function DSiSetDllDirectory(path: PChar): boolean; stdcall;
function DSiSetSuspendState(hibernate: BOOL; forceCritical: BOOL = False;
  disableWakeEvent: BOOL = False): BOOL; stdcall;
function DSiSHEmptyRecycleBin(Wnd: HWND; pszRootPath: PChar;
  dwFlags: DWORD): HRESULT; stdcall;
function DSiWow64DisableWow64FsRedirection(var oldStatus: pointer): BOOL; stdcall;
function DSiWow64RevertWow64FsRedirection(const oldStatus: pointer): BOOL; stdcall;

{ Helpers }

{$IFDEF NeedUTF}
// UTF <-> 16-bit conversion. Same signature as D7 functions but custom implementation
// (taken from http://gp.17slon.com/gp/gptextstream.htm with permission).

type
  UTF8String = type string;
  PUTF8String = ^UTF8String;

function UTF8Encode(const ws: WideString): UTF8String;
function UTF8Decode(const sUtf: UTF8String): WideString;
{$ENDIF NeedUTF}

{ internals used in inline functions }

type
  TInterlockedCompareExchange64 = function(destination: pointer;
    exchange, comparand: int64): int64; stdcall;

var
  GInterlockedCompareExchange64: TInterlockedCompareExchange64 = nil;

implementation

uses
  Types,
  ComObj,
  ActiveX,
  {$IFDEF CONDITIONALCOMPILATION}
  Variants,
  {$ENDIF}
  TLHelp32,
  MMSystem;

const
  CAPISuffix = {$IFDEF Unicode}'W'{$ELSE}'A'{$ENDIF};

type
  IRestoreLastError = interface
  end; { IRestoreLastError }

  TRestoreLastError = class(TInterfacedObject, IRestoreLastError)
  private
    rleLastError: DWORD;
  public
    constructor Create;
    destructor Destroy; override;
  end; { TRestoreLastError }

  TBackgroundTask = class
  private
    btWaitObject: THandle;
  public
    constructor Create(waitObject: THandle);
    procedure Awaited; virtual; abstract;
    property WaitObject: THandle Read btWaitObject;
  end; { TBackgroundTask }

  TCleanupAces = class(TBackgroundTask)
  private
    caDesktop: HDESK;
    caSid: PSID;
    caWindowStation: HWINSTA;
  public
    constructor Create(waitObject: THandle; windowStation: HWINSTA;
      desktop: HDESK; sid: PSID);
    destructor Destroy; override;
    procedure Awaited; override;
  end; { TCleanupAces }

  TBackgroundThread = class(TThread)
  private
    btTask: TBackgroundTask;
  public
    constructor Create(task: TBackgroundTask);
    procedure Execute; override;
  end; { TBackgroundThread }

  T9xNetShareAdd = function(serverName: PChar; shareLevel: smallint;
    buffer: pointer; size: word): integer; stdcall;
  T9xNetShareDel = function(serverName: PChar; netName: PChar;
    reserved: word): integer; stdcall;
  TCloseServiceHandle = function(hSCObject: SC_HANDLE): BOOL; stdcall;
  TCreateProcessAsUser = function(hToken: THandle; lpApplicationName: PChar;
    lpCommandLine: PChar; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
    bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: pointer;
    lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
    var lpProcessInformation: TProcessInformation): BOOL; stdcall;
  TCreateProcessWithLogonW = function(lpUsername, lpDomain, lpPassword: PWideChar;
    dwLogonFlags: DWORD; lpApplicationName, lpCommandLine: PWideChar;
    dwCreationFlags: DWORD; lpEnvironment: pointer; lpCurrentDirectory: PWideChar;
    const lpStartupInfo: TStartupInfoW;
    var lpProcessInformation: TProcessInformation): BOOL; stdcall;
  TCreateEnvironmentBlock = function(var lpEnvironment: pointer;
    hToken: THandle; bInherit: BOOL): BOOL; stdcall;
  TDestroyEnvironmentBlock = function(lpEnvironment: pointer): BOOL; stdcall;
  TDwmEnableComposition = function(uCompositionAction: UINT): HRESULT; stdcall;
  TDwmIsCompositionEnabled = function(var pfEnabled: BOOL): HRESULT; stdcall;
  TEnumProcessModules = function(hProcess: THandle; lphModule: PModule;
    cb: DWORD; var lpcbNeeded: DWORD): BOOL; stdcall;
  TGetLongPathName = function(lpszShortPath, lpszLongPath: PChar;
    cchBuffer: DWORD): DWORD; stdcall;
  TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE;
    lpFilename: PChar; nSize: DWORD): DWORD; stdcall;
  TGetProcessImageFileName = function(hProcess: THandle; lpImageFileName: PChar;
    nSize: DWORD): DWORD; stdcall;
  TGetProcessMemoryInfo = function(process: THandle;
    memCounters: PProcessMemoryCounters; cb: DWORD): boolean; stdcall;
  TGetTickCount64 = function: int64; stdcall;
  TGetUserProfileDirectoryW = function(hToken: THandle; lpProfileDir: PWideChar;
    var lpcchSize: DWORD): BOOL; stdcall;
  TGlobalMemoryStatusEx = function(memStatus: PMemoryStatusEx): boolean; stdcall;
  TImpersonateLoggedOnUser = function(hToken: THandle): BOOL; stdcall;
  TIsWow64Process = function(hProcess: THandle; var wow64Process: BOOL): BOOL; stdcall;
  TLogonUser = function(lpszUsername, lpszDomain, lpszPassword: LPCSTR;
    dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL; stdcall;
  TNetApiBufferFree = function(buffer: pointer): cardinal; stdcall;
  TNetWkstaGetInfo = function(servername: PChar; level: cardinal;
    out bufptr: pointer): cardinal; stdcall;
  TNTNetShareAdd = function(serverName: PChar; level: integer;
    buf: PChar; var parm_err: integer): DWord; stdcall;
  TNTNetShareDel = function(serverName: PChar; netName: PWideChar;
    reserved: integer): DWord; stdcall;
  TOpenSCManager = function(lpMachineName, lpDatabaseName: PChar;
    dwDesiredAccess: DWORD): SC_HANDLE; stdcall;
  TRevertToSelf = function: BOOL; stdcall;
  TSetDllDirectory = function(path: PChar): boolean; stdcall;
  TSetSuspendState = function(hibernate, forceCritical, disableWakeEvent: BOOL): BOOL;
    stdcall;
  TSHEmptyRecycleBin = function(wnd: HWND; pszRootPath: PChar;
    dwFlags: DWORD): HRESULT; stdcall;
  TWow64DisableWow64FsRedirection = function(var oldStatus: pointer): BOOL; stdcall;
  TWow64RevertWow64FsRedirection = function(const oldStatus: pointer): BOOL; stdcall;

const
  G9xNetShareAdd: T9xNetShareAdd = nil;
  G9xNetShareDel: T9xNetShareDel = nil;
  GCloseServiceHandle: TCloseServiceHandle = nil;
  GCreateProcessAsUser: TCreateProcessAsUser = nil;
  GCreateProcessWithLogonW: TCreateProcessWithLogonW = nil;
  GCreateEnvironmentBlock: TCreateEnvironmentBlock = nil;
  GDestroyEnvironmentBlock: TDestroyEnvironmentBlock = nil;
  GDwmEnableComposition: TDwmEnableComposition = nil;
  GDwmIsCompositionEnabled: TDwmIsCompositionEnabled = nil;
  GEnumProcessModules: TEnumProcessModules = nil;
  GGetModuleFileNameEx: TGetModuleFileNameEx = nil;
  GGetLongPathName: TGetLongPathName = nil;
  GGetProcessImageFileName: TGetProcessImageFileName = nil;
  GGetProcessMemoryInfo: TGetProcessMemoryInfo = nil;
  GGetTickCount64: TGetTickCount64 = nil;
  GGetUserProfileDirectoryW: TGetUserProfileDirectoryW = nil;
  GGlobalMemoryStatusEx: TGlobalMemoryStatusEx = nil;
  GImpersonateLoggedOnUser: TImpersonateLoggedOnUser = nil;
  GIsWow64Process: TIsWow64Process = nil;
  GLogonUser: TLogonUser = nil;
  GNetApiBufferFree: TNetApiBufferFree = nil;
  GNetWkstaGetInfo: TNetWkstaGetInfo = nil;
  GNTNetShareAdd: TNTNetShareAdd = nil;
  GNTNetShareDel: TNTNetShareDel = nil;
  GOpenSCManager: TOpenSCManager = nil;
  GRevertToSelf: TRevertToSelf = nil;
  GSetDllDirectory: TSetDllDirectory = nil;
  GSetSuspendState: TSetSuspendState = nil;
  GSHEmptyRecycleBin: TSHEmptyRecycleBin = nil;
  GWow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection = nil;
  GWow64RevertWow64FsRedirection: TWow64RevertWow64FsRedirection = nil;

{$IFOPT R+} {$DEFINE RestoreR} {$ELSE} {$UNDEF RestoreR} {$ENDIF}

{ Helpers }

procedure CreateProcessWatchdog(task: TBackgroundTask);
begin
  TBackgroundThread.Create(task);
end; { CreateProcessWatchdog }

function FileOpenSafe(fileName: string; var fileHandle: textfile;
  diskRetryDelay, diskRetryCount: integer): boolean;
var
  dum: integer;
begin
  Assign(fileHandle, fileName);
    {$I-}
  repeat
    if FileExists(fileName) then
      Reset(fileHandle)
    else
      Rewrite(fileHandle);
    dum := IOResult;
    if (dum in [ERROR_SHARING_VIOLATION, ERROR_LOCK_VIOLATION]) and
      (diskRetryDelay > 0) then
    begin
      Sleep(diskRetryDelay);
      if diskRetryCount > 0 then
        Dec(diskRetryCount);
    end;
  until (not (dum in [ERROR_SHARING_VIOLATION, ERROR_LOCK_VIOLATION])) or
    (diskRetryCount = 0);
    {$I+}
  Result := (dum = 0);
end; { FileOpenSafe }

{$IFDEF NeedUTF}
  {:Convers buffer of WideChars into UTF-8 encoded form. Target buffer must be
    pre-allocated and large enough (each WideChar will use at most three bytes
    in UTF-8 encoding).                                                            <br>
    RFC 2279 (http://www.ietf.org/rfc/rfc2279.txt) describes the conversion:       <br>
    $0000..$007F => $00..$7F                                                       <br>
    $0080..$07FF => 110[bit10..bit6] 10[bit5..bit0]                                <br>
    $0800..$FFFF => 1110[bit15..bit12] 10[bit11..bit6] 10[bit5..bit0]
    @param   unicodeBuf   Buffer of WideChars.
    @param   uniByteCount Size of unicodeBuf, in bytes.
    @param   utf8Buf      Pre-allocated buffer for UTF-8 encoded result.
    @returns Number of bytes used in utf8Buf buffer.
    @since   2.01
  }
  function WideCharBufToUTF8Buf(const unicodeBuf; uniByteCount: integer;
    var utf8Buf): integer;
  var
    iwc: integer;
    pch: PChar;
    pwc: PWideChar;
    wc : word;
  
    procedure AddByte(b: byte);
    begin
      pch^ := char(b);
      Inc(pch);
    end; { AddByte }
  
  begin { WideCharBufToUTF8Buf }
    pwc := @unicodeBuf;
    pch := @utf8Buf;
    for iwc := 1 to uniByteCount div SizeOf(WideChar) do begin
      wc := Ord(pwc^);
      Inc(pwc);
      if (wc >= $0001) and (wc <= $007F) then begin
        AddByte(wc AND $7F);
      end
      else if (wc >= $0080) and (wc <= $07FF) then begin
        AddByte($C0 OR ((wc SHR 6) AND $1F));
        AddByte($80 OR (wc AND $3F));
      end
      else begin // (wc >= $0800) and (wc <= $FFFF)
        AddByte($E0 OR ((wc SHR 12) AND $0F));
        AddByte($80 OR ((wc SHR 6) AND $3F));
        AddByte($80 OR (wc AND $3F));
      end;
    end; //for
    Result := integer(pch)-integer(@utf8Buf);
  end; { WideCharBufToUTF8Buf }
  
  {:Converts UTF-8 encoded buffer into WideChars. Target buffer must be
    pre-allocated and large enough (at most utfByteCount number of WideChars will
    be generated).                                                                 <br>
    RFC 2279 (http://www.ietf.org/rfc/rfc2279.txt) describes the conversion:       <br>
    $00..$7F => $0000..$007F                                                       <br>
    110[bit10..bit6] 10[bit5..bit0] => $0080..$07FF                                <br>
    1110[bit15..bit12] 10[bit11..bit6] 10[bit5..bit0] => $0800..$FFFF
    @param   utf8Buf      UTF-8 encoded buffer.
    @param   utfByteCount Size of utf8Buf, in bytes.
    @param   unicodeBuf   Pre-allocated buffer for WideChars.
    @param   leftUTF8     Number of bytes left in utf8Buf after conversion (0, 1,
                          or 2).
    @returns Number of bytes used in unicodeBuf buffer.
    @since   2.01
  }
  function UTF8BufToWideCharBuf(const utf8Buf; utfByteCount: integer;
   var unicodeBuf; var leftUTF8: integer): integer;
  var
    c1 : byte;
    c2 : byte;
    ch : byte;
    pch: PChar;
    pwc: PWideChar;
  begin
    pch := @utf8Buf;
    pwc := @unicodeBuf;
    leftUTF8 := utfByteCount;
    while leftUTF8 > 0 do begin
      ch := byte(pch^);
      Inc(pch);
      if (ch AND $80) = 0 then begin // 1-byte code
        word(pwc^) := ch;
        Inc(pwc);
        Dec(leftUTF8);
      end
      else if (ch AND $E0) = $C0 then begin // 2-byte code
        if leftUTF8 < 2 then
          break;
        c1 := byte(pch^);
        Inc(pch);
        word(pwc^) := (word(ch AND $1F) SHL 6) OR (c1 AND $3F);
        Inc(pwc);
        Dec(leftUTF8,2);
      end
      else begin // 3-byte code
        if leftUTF8 < 3 then
          break;
        c1 := byte(pch^);
        Inc(pch);
        c2 := byte(pch^);
        Inc(pch);
        word(pwc^) :=
          (word(ch AND $0F) SHL 12) OR
          (word(c1 AND $3F) SHL 6) OR
          (c2 AND $3F);
        Inc(pwc);
        Dec(leftUTF8,3);
      end;
    end; //while
    Result := integer(pwc)-integer(@unicodeBuf);
  end; { UTF8BufToWideCharBuf }

  function UTF8Encode(const ws: WideString): UTF8String;
  begin
    if ws = '' then
      Result := ''
    else begin
      SetLength(Result, Length(ws)*3); // worst case - 3 bytes per character
      SetLength(Result, WideCharBufToUTF8Buf(ws[1], Length(ws)*SizeOf(WideChar),
        Result[1]));
    end;
  end; { UTF8Encode }

  function UTF8Decode(const sUtf: UTF8String): WideString;
  var
    leftUtf: integer;
  begin
    if sUtf = '' then
      Result := ''
    else begin
      SetLength(Result, Length(sUtf)); // worst case - 1 widechar per character
      SetLength(Result, UTF8BufToWideCharBuf(sUtf[1], Length(sUtf), Result[1], leftUtf)
        div SizeOf(WideChar));
    end;
  end; { UTF8Decode }
{$ENDIF NeedUTF}

{ Handles }

  {:Closes handle (if it is not already INVALID_HANDLE_VALUE) and sets it to
    INVALID_HANDLE_VALUE.
    @author  gabr
    @since   2002-11-25
  }
procedure DSiCloseHandleAndInvalidate(var handle: THandle);
begin
  if handle <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(handle);
    handle := INVALID_HANDLE_VALUE;
  end;
end; { DSiCloseHandleAndInvalidate }

  {:Closes handle (if it is not already 0) and sets it to 0.
    @author  gabr
    @since   2002-11-25
  }
procedure DSiCloseHandleAndNull(var handle: THandle);
begin
  if handle <> 0 then
  begin
    CloseHandle(handle);
    handle := 0;
  end;
end; { DSiCloseHandleAndNull }

  {:Shortcut for WaitForMultipleObjects with two objects.
    @author  gabr
    @since   2002-11-25
  }
function DSiWaitForTwoObjects(obj0, obj1: THandle; waitAll: boolean;
  timeout: DWORD): DWORD;
var
  handles: array [0..1] of THandle;
begin
  handles[0] := obj0;
  handles[1] := obj1;
  Result := WaitForMultipleObjects(2, @handles, waitAll, timeout);
end; { DSiWaitForTwoObjects }

  {:Shortcut for WaitForMultipleObjectsEx with two objects.
    @author  gabr
    @since   2002-11-25
  }
function DSiWaitForTwoObjectsEx(obj0, obj1: THandle; waitAll: boolean;
  timeout: DWORD; alertable: boolean): DWORD;
var
  handles: array [0..1] of THandle;
begin
  handles[0] := obj0;
  handles[1] := obj1;
  Result := WaitForMultipleObjectsEx(2, @handles, waitAll, timeout, alertable);
end; { DSiWaitForTwoObjectsEx }

  {:As Win32Check, only used for file handles.
    @author  gabr
    @since   2003-11-12
  }
function DSiWin32CheckHandle(handle: THandle): THandle;
begin
  Win32Check(handle <> INVALID_HANDLE_VALUE);
  Result := handle;
end; { TDSiRegistry.DSiWin32CheckHandle }

  {:As Win32Check, only used for various handles.
    @author  gabr
    @since   2005-07-11
  }
function DSiWin32CheckNullHandle(handle: THandle): THandle;
begin
  Win32Check(handle <> 0);
  Result := handle;
end; { TDSiRegistry.DSiWin32CheckNullHandle }

  {:Shortcut for MsgWaitForMultipleObjects with two objects.
    @author  gabr
    @since   2002-11-25
  }
function DSiMsgWaitForTwoObjectsEx(obj0, obj1: THandle; timeout: DWORD;
  wakeMask: DWORD; flags: DWORD): DWORD;
var
  handles: array [0..1] of THandle;
begin
  handles[0] := obj0;
  handles[1] := obj1;
  Result := MsgWaitForMultipleObjectsEx(2, handles, timeout, wakeMask, flags);
end; { DSiWaitForThreeObjects }

  {:Shortcut for WaitForMultipleObjects with three objects.
    @author  gabr
    @since   2002-11-25
  }
function DSiWaitForThreeObjects(obj0, obj1, obj2: THandle; waitAll: boolean;
  timeout: DWORD): DWORD;
var
  handles: array [0..2] of THandle;
begin
  handles[0] := obj0;
  handles[1] := obj1;
  handles[2] := obj2;
  Result := WaitForMultipleObjects(3, @handles, waitAll, timeout);
end; { DSiWaitForThreeObjects }

  {:Shortcut for WaitForMultipleObjectsEx with three objects.
    @author  gabr
    @since   2002-11-25
  }
function DSiWaitForThreeObjectsEx(obj0, obj1, obj2: THandle;
  waitAll: boolean; timeout: DWORD; alertable: boolean): DWORD;
var
  handles: array [0..2] of THandle;
begin
  handles[0] := obj0;
  handles[1] := obj1;
  handles[2] := obj2;
  Result := WaitForMultipleObjectsEx(3, @handles, waitAll, timeout, alertable);
end; { DSiWaitForThreeObjectsEx }

  {:Shortcut for MsgWaitForMultipleObjectsEx with three objects.
    @author  gabr
    @since   2002-11-25
  }
function DSiMsgWaitForThreeObjectsEx(obj0, obj1, obj2: THandle;
  timeout: DWORD; wakeMask: DWORD; flags: DWORD): DWORD;
var
  handles: array [0..2] of THandle;
begin
  handles[0] := obj0;
  handles[1] := obj1;
  handles[2] := obj2;
  Result := MsgWaitForMultipleObjectsEx(3, handles, timeout, wakeMask, flags);
end; { DSiWaitForThreeObjectsEx }

{ Registry }

  {:Reads binary from the registry returning default value if name doesn't exist in the
    open key. Includes special handling for integer and string keys.
    @author  Lee_Nover
    @since   2004-11-29
  }
function TDSiRegistry.ReadBinary(const Name: string;
  const defval: RawByteString): RawByteString;
begin
  try
    if GetDataSize(Name) < 0 then
      Abort; // D4 does not generate an exception!
    case GetDataType(Name) of
      rdInteger:
        Result := RawByteString(IntToStr(inherited ReadInteger(Name)));
      rdBinary:
      begin
        SetLength(Result, GetDataSize(Name));
        SetLength(Result, ReadBinaryData(Name, pointer(Result)^, Length(Result)));
      end; //rdBinary
      else
        Result := RawByteString(inherited ReadString(Name));
    end;
  except
    ReadBinary := defval;
  end;
end; { TDSiRegistry.ReadBinary }

  {:Reads binary from the registry. Overwrites 'dataStream'. Keeps data stream unchanged
    if value is not found in the registry.
    Includes special handling for integer and string keys.
    @author  gabr
    @returns True if value exists in the registry.
    @since   2005-02-13
  }
function TDSiRegistry.ReadBinary(const Name: string; dataStream: TStream): boolean;
var
  i: integer;
  s: RawByteString;
begin
  try
    if GetDataSize(Name) < 0 then
      Abort; // D4 does not generate an exception!
    dataStream.Size := 0;
    case GetDataType(Name) of
      rdInteger:
      begin
        i := ReadInteger(Name, 0);
        dataStream.Write(i, SizeOf(i));
      end; //rdInteger
      rdBinary:
        if dataStream is TMemoryStream then
        begin
          dataStream.Size := GetDataSize(Name);
          dataStream.Position := 0;
          ReadBinaryData(Name, TMemoryStream(dataStream).Memory^, dataStream.Size);
        end
        else
        begin
          s := ReadBinary(Name, '');
          if s <> '' then
            dataStream.Write(s[1], Length(s));
        end; //rdBinary
      else
      begin
        s := RawByteString(ReadString(Name, ''));
        if s <> '' then
          dataStream.Write(s[1], Length(s));
      end; //else
    end; //case
    Result := True;
  except
    Result := False;
  end;
end; { TDSiRegistry.ReadBinary }

  {:Reads boolean value from the registry returning default value if name doesn't exist in
    the open key.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadBool(const Name: string; defval: boolean): boolean;
begin
  try
    if GetDataSize(Name) < 0 then
      Abort; // D4 does not generate an exception!
    ReadBool := inherited ReadBool(Name);
  except
    ReadBool := defval;
  end;
end; { TDSiRegistry.ReadBool }

  {:Reads date-time from the registry returning default value if name doesn't
    exist in the open key.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadDate(const Name: string; defval: TDateTime): TDateTime;
begin
  try
    if GetDataSize(Name) < 0 then
      Abort; // D4 does not generate an exception!
    ReadDate := inherited ReadDate(Name);
  except
    ReadDate := defval;
  end;
end; { TDSiRegistry.ReadDate }

  {:Reads TFont from the registry.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadFont(const Name: string; font: TFont): boolean;
var
  istyle: integer;
  fstyle: TFontStyles;
begin
  Result := False;
  if GetDataSize(Name) > 0 then
  begin
    font.Charset := ReadInteger(Name + '_charset', font.Charset);
    font.Color := ReadInteger(Name + '_color', font.Color);
    font.Height := ReadInteger(Name + '_height', font.Height);
    font.Name := ReadString(Name, font.Name);
    font.Pitch := TFontPitch(ReadInteger(Name + '_pitch', Ord(font.Pitch)));
    font.Size := ReadInteger(Name + '_size', font.Size);
    fstyle := font.Style;
    istyle := 0;
    Move(fstyle, istyle, SizeOf(TFontStyles));
    istyle := ReadInteger(Name + '_style', istyle);
    Move(istyle, fstyle, SizeOf(TFontStyles));
    font.Style := fstyle;
    Result := True;
  end;
end; { TDSiRegistry.ReadFont }

  {:Reads integer from the registry returning default value if name doesn't
    exist in the open key.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadInteger(const Name: string; defval: integer): integer;
begin
  try
    if GetDataSize(Name) < 0 then
      Abort; // D4 does not generate an exception!
    if GetDataType(Name) = rdInteger then
      Result := inherited ReadInteger(Name)
    else if (GetDataType(Name) = rdBinary) and (GetDataSize(Name) =
      SizeOf(Result)) then
      ReadBinaryData(Name, Result, SizeOf(Result))
    else
      Result := StrToIntDef(ReadString(Name, IntToStr(defval)), defval);
  except
    ReadInteger := defval;
  end;
end; { TDSiRegistry.ReadInteger }

  {:Reads 64-bit integer from the registry returning default value if name
    doesn't exist in the open key.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadInt64(const Name: string; defval: int64): int64;
begin
  Result := StrToInt64Def(ReadString(Name, '!'), defval);
end; { TDSiRegistry.ReadInt64 }

  {:Reads string from the registry returning default value if name doesn't exist
    in the open key.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadString(const Name, defval: string): string;
begin
  Result := defval;
  try
    if GetDataSize(Name) < 0 then
      Exit;
    if GetDataType(Name) = rdInteger then
      Result := IntToStr(inherited ReadInteger(Name))
    else
      Result := inherited ReadString(Name);
  except
    Result := defval;
  end;
end; { TDSiRegistry.ReadString }

  {:Writes a MULTI_SZ value into the TStrings object.
    @author  Colin Wilson, borland.public.delphi.vcl.components.using
    @since   2003-10-02
  }
procedure TDSiRegistry.ReadStrings(const Name: string; strings: TStrings);
var
  buffer: PChar;
  p: PChar;
  valueLen: DWORD;
  valueType: DWORD;
begin
  strings.Clear;
  SetLastError(RegQueryValueEx(CurrentKey, PChar(Name), nil, @valueType,
    nil, @valueLen));
  if GetLastError <> ERROR_SUCCESS then
    raise ERegistryException.CreateFmt('Unable read MULTI_SZ value. %s',
      [SysErrorMessage(GetLastError)])
  else if valueType <> REG_MULTI_SZ then
    raise ERegistryException.Create('String list expected.')
  else
  begin
    GetMem(buffer, valueLen);
    try
      RegQueryValueEx(CurrentKey, PChar(Name), nil, nil, PByte(buffer),
        @valueLen);
      p := buffer;
      while p^ <> #0 do
      begin
        strings.Add(p);
        Inc(p, LStrLen(p) + 1);
      end
    finally
      FreeMem(buffer);
    end;
  end;
end; { TDSiRegistry.ReadStrings }

  {:Reads variant (string, integer, boolean, or date-time) from the registry
    returning default value if name doesn't exist in the open key.
    @author  gabr
    @since   2002-11-25
  }
function TDSiRegistry.ReadVariant(const Name: string; defval: variant): variant;
begin
  case VarType(defval) of
    varInteger: Result := ReadInteger(Name, defval);
    varBoolean: Result := ReadBool(Name, defval);
    varString: Result := ReadString(Name, defval);
      {$IFDEF Unicode}
      varOleStr,
      varUString: Result := ReadString(name, defval);
      {$ELSE}
    varOleStr: Result := UTF8Decode(ReadString(Name, UTF8Encode(defval)));
      {$ENDIF Unicode}
    varDate: Result := ReadDate(Name, defval);
    else
      raise Exception.Create('TDSiRegistry.ReadVariant: Invalid value type!');
  end;
end; { TDSiRegistry.ReadVariant }

  {:Writes string as binary into the registry.
    @author  Lee_Nover
    @since   2004-11-29
  }
procedure TDSiRegistry.WriteBinary(const Name: string; Data: RawByteString);
begin
  if Data = '' then
    WriteBinaryData(Name, Data, 0)
  else
    WriteBinaryData(Name, Data[1], Length(Data));
end; { TDSiRegistry.WriteBinary }

  {:Writes stream into binary registry entry.
    @author  gabr
    @since   2005-02-13
  }
procedure TDSiRegistry.WriteBinary(const Name: string; Data: TStream);
var
  ms: TMemoryStream;
begin
  if Data is TMemoryStream then
    WriteBinaryData(Name, TMemoryStream(Data).Memory^, Data.Size)
  else
  begin
    ms := TMemoryStream.Create;
    try
      ms.CopyFrom(Data, 0);
      WriteBinaryData(Name, ms.Memory^, ms.Size);
    finally
      FreeAndNil(ms);
    end;
  end;
end; { TDSiRegistry.WriteBinary }

  {:Writes 64-bit integer into the registry.
    @author  gabr
    @since   2002-11-25
  }
procedure TDSiRegistry.WriteInt64(const Name: string; Value: int64);
begin
  WriteString(Name, IntToStr(Value));
end; { TDSiRegistry.WriteInt64 }

  {:Writes variant (string, integer, boolean, or date-time) into the registry.
    @author  gabr
    @since   2002-11-25
  }
procedure TDSiRegistry.WriteVariant(const Name: string; Value: variant);
begin
  case VarType(Value) of
    varByte,
    varWord,
    varLongWord,
    varInteger: WriteInteger(Name, Value);
    varBoolean: WriteBool(Name, Value);
    varString: WriteString(Name, Value);
      {$IFDEF Unicode}
      varOleStr,
      varUString: WriteString(name, value);
      {$ELSE}
    varOleStr: WriteString(Name, UTF8Encode(Value));
      {$ENDIF Unicode}
    varDate: WriteDate(Name, Value);
    else
      raise Exception.Create('TDSiRegistry.WriteVariant: Invalid value type!');
  end;
end; { TDSiRegistry.WriteVariant }

  {:Writes TFont into the registry.
    @author  gabr
    @since   2002-11-25
  }
procedure TDSiRegistry.WriteFont(const Name: string; font: TFont);
var
  istyle: integer;
  fstyle: TFontStyles;
begin
  WriteInteger(Name + '_charset', font.Charset);
  WriteInteger(Name + '_color', font.Color);
  WriteInteger(Name + '_height', font.Height);
  WriteString(Name, font.Name);
  WriteInteger(Name + '_pitch', Ord(font.Pitch));
  WriteInteger(Name + '_size', font.Size);
  fstyle := font.Style;
  istyle := 0;
  Move(fstyle, istyle, SizeOf(TFontStyles));
  WriteInteger(Name + '_style', istyle);
end; { TDSiRegistry.WriteFont }

  {:Writes TStrings into a MULTI_SZ value.
    @author  Colin Wilson, borland.public.delphi.vcl.components.using 
    @since   2003-10-02
  }
procedure TDSiRegistry.WriteStrings(const Name: string; strings: TStrings);
var
  buffer: PChar;
  i: integer;
  p: PChar;
  size: DWORD;
begin
  size := 0;
  for i := 0 to strings.Count - 1 do
    Inc(size, Length(strings[i]) + 1);
  Inc(size);
  GetMem(buffer, size);
  try
    p := buffer;
    for i := 0 to strings.Count - 1 do
    begin
      LStrCpy(p, PChar(strings[i]));
      Inc(p, LStrLen(p) + 1);
    end;
    p^ := #0;
    SetLastError(RegSetValueEx(CurrentKey, PChar(Name), 0, REG_MULTI_SZ,
      buffer, size));
    if GetLastError <> ERROR_SUCCESS then
      raise ERegistryException.CreateFmt('Unable to write MULTI_SZ value. %s',
        [SysErrorMessage(GetLastError)]);
  finally
    FreeMem(buffer);
  end;
end; { TDSiRegistry.WriteStrings }

  {:Creates a key in the registry.
    @author  gabr
    @since   2002-11-25
  }
function DSiCreateRegistryKey(const registryKey: string; root: HKEY): boolean;
begin
  Result := False;
  with TRegistry.Create do
    try
      RootKey := root;
      if OpenKey(registryKey, True) then
      begin
        CloseKey;
        Result := True;
      end;
    finally
      {TRegistry.}Free;
    end;
end; { DSiCreateRegistryKey }

  {:Deletes a value from the registry.
    @author  gabr
    @since   2009-11-13
  }
function DSiDeleteRegistryValue(const registryKey, Name: string;
  root: HKEY = HKEY_CURRENT_USER; access: longword = KEY_SET_VALUE): boolean;
begin
  Result := False;
  try
    with TDSiRegistry.Create(access) do
      try
        RootKey := root;
        if OpenKey(registryKey, True) then
          try
            Result := DeleteValue(Name);
          finally
            CloseKey;
          end;
      finally
        {TDSiRegistry.}Free;
      end;
  except
  end;
end; { DSiDeleteRegistryValue }

  {:Deletes a key with all subkeys from the registry.
    @author  gabr
    @since   2002-11-25
  }
function DSiKillRegistry(const registryKey: string; root: HKEY;
  access: longword): boolean;
begin
  with TRegistry.Create(access) do
    try
      RootKey := root;
      Result  := DeleteKey(registryKey);
    finally
      {TRegistry.}  Free;
    end;
end; { DSiKillRegistry }

  {:Reads 64-bit integer from the registry, returning default value if the
    specified name doesn't exist in the registry.
    @author  gabr
    @since   2002-11-25
  }
function DSiReadRegistry(const registryKey, Name: string; defaultValue: int64;
  root: HKEY; access: longword): int64;
begin
  Result := defaultValue;
  try
    with TDSiRegistry.Create(access) do
      try
        RootKey := root;
        if OpenKeyReadOnly(registryKey) then
          try
            Result := ReadInt64(Name, defaultValue);
          finally
            CloseKey;
          end;
      finally
        {TDSiRegistry.}Free;
      end;
  except
  end;
end; { DSiReadRegistry }

  {:Reads variant (string, integer, boolean, or date-time) from the registry,
    returning default value if the specified name doesn't exist in the registry.
    @author  gabr
    @since   2002-11-25
  }
function DSiReadRegistry(const registryKey, Name: string; defaultValue: variant;
  root: HKEY; access: longword): variant;
begin
  Result := defaultValue;
  try
    with TDSiRegistry.Create(access) do
      try
        RootKey := root;
        if OpenKeyReadOnly(registryKey) then
          try
            Result := ReadVariant(Name, defaultValue);
          finally
            CloseKey;
          end;
      finally
        {TDSiRegistry.}Free;
      end;
  except
  end;
end; { DSiReadRegistry }

  {:Checks whether the specified registry key exists.
    @author  gabr
    @since   2002-11-25
  }
function DSiRegistryKeyExists(const registryKey: string; root: HKEY;
  access: longword): boolean;
begin
  with TRegistry.Create(access) do
    try
      RootKey := root;
      Result  := KeyExists(registryKey);
    finally
      {TRegistry.}Free;
    end;
end; { DSiRegistryKeyExists }

  {:Checks whether the specified registry value exists.
    @author  gabr
    @since   2006-02-06
  }
function DSiRegistryValueExists(const registryKey, Name: string;
  root: HKEY; access: longword): boolean;
begin
  Result := False;
  with TRegistry.Create(access) do
    try
      RootKey := root;
      if OpenKeyReadOnly(registryKey) then
        try
          Result := ValueExists(Name);
        finally
          CloseKey;
        end;
    finally
      {TRegistry.}Free;
    end;
end; { DSiRegistryKeyExists }

  {:Writes 64-bit integer into the registry.
    @author  gabr
    @since   2002-11-25
  }
function DSiWriteRegistry(const registryKey, Name: string; Value: int64;
  root: HKEY; access: longword): boolean;
begin
  Result := False;
  try
    with TDSiRegistry.Create(access) do
      try
        RootKey := root;
        if OpenKey(registryKey, True) then
          try
            WriteInt64(Name, Value);
            Result := True;
          finally
            CloseKey;
          end;
      finally
        {TDSiRegistry.}Free;
      end;
  except
  end;
end; { DSiWriteRegistry }

  {:Writes variant (string, integer, boolean, or date-time) into the registry.
    @author  gabr
    @since   2002-11-25
  }
function DSiWriteRegistry(const registryKey, Name: string; Value: variant;
  root: HKEY; access: longword): boolean;
begin
  Result := False;
  try
    with TDSiRegistry.Create(access) do
      try
        RootKey := root;
        if OpenKey(registryKey, True) then
          try
            WriteVariant(Name, Value);
            Result := True;
          finally
            CloseKey;
          end;
      finally
        {TDSiRegistry.}Free;
      end;
  except
  end;
end; { DSiWriteRegistry }

{ Files }

  {:Checks if application can write to a folder.
    @author  gabr
    @since   2005-12-08
  }
function DSiCanWriteToFolder(const folderName: string): boolean;
var
  tempFile: string;
begin
  Result := False;
  if DirectoryExists(folderName) then
  begin
    tempFile := DSiGetTempFileName('dsi', folderName);
    if tempFile <> '' then
    begin
      DSiKillFile(tempFile);
      Result := True;
    end;
  end;
end; { DSiCanWriteToFolder }

  {:Internal. Sets specified compression flag.
    @since   2006-08-14
  }
function DSiSetCompression(fileHandle: THandle; compressionFormat: integer): boolean;
var
  comp: SHORT;
  res:  DWORD;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then //only NT can compress files
    Result := True
  else
  begin
    res  := 0;
    comp := compressionFormat;
    Result := DeviceIoControl(fileHandle, FSCTL_SET_COMPRESSION,
      @comp, SizeOf(SHORT), nil, 0, res, nil);
  end;
end; { DSiSetCompression }

  {:Compresses file on NTFS filesystem.
    @author  gabr
    @since   2006-08-14
  }
function DSiCompressFile(fileHandle: THandle): boolean;
begin
  Result := DSiSetCompression(fileHandle, COMPRESSION_FORMAT_DEFAULT);
end; { DSiCompressFile }

  {:Connects to a network resource and optionally maps drive letter to it.
    @author  gabr
    @since   2008-05-05
  }
function DSiConnectToNetworkResource(const networkResource: string;
  const mappedLetter: string; const username: string; const password: string): boolean;
var
  driveName:  string;
  isAvailable: boolean;
  netResource: TNetResource;
  remoteName: string;
begin
  Result := False;
  if mappedLetter <> '' then
    if DSiGetNetworkResource(mappedLetter[1], remoteName, isAvailable) and
      (remoteName <> '') then
      if AnsiSameText(remoteName, networkResource) then
        Result := True
      else
        DSiDisconnectFromNetworkResource(mappedLetter[1]);
  if not Result then
  begin
    FillChar(netResource, SizeOf(netResource), 0);
    netResource.dwScope := RESOURCE_GLOBALNET;
    netResource.dwType  := RESOURCETYPE_DISK;
    netResource.dwDisplayType := RESOURCEDISPLAYTYPE_SHARE;
    netResource.dwUsage := RESOURCEUSAGE_CONNECTABLE;
    if mappedLetter <> '' then
    begin
      driveName := mappedLetter + ':'#0;
      netResource.lpLocalName := PChar(@driveName[1]);
    end;
    netResource.lpRemoteName := PChar(networkResource);
    Result := (WNetAddConnection2(netResource, PChar(password),
      PChar(username), 0) = NO_ERROR);
  end;
end; { DSiConnectToNetworkResource }

  {:Copies a file via ShFileOperation (with animated icon etc).
    @author  gabr
    @since   2008-05-30
  }
function DSiCopyFileAnimated(ownerWindowHandle: THandle;
  sourceFile, destinationFile: string; var aborted: boolean;
  flags: TShFileOpFlags): boolean;
var
  fileOp: TSHFileOpStruct;
  flag: TShFileOpFlag;
begin
  FillChar(fileOp, SizeOf(fileOp), 0);
  fileOp.Wnd := ownerWindowHandle;
  fileOp.wFunc := FO_COPY;
  sourceFile := sourceFile + #0#0;
  fileOp.pFrom := PChar(sourceFile);
  destinationFile := destinationFile + #0#0;
  fileOp.pTo := PChar(destinationFile);
  fileOp.fFlags := 0;
  for flag := Low(TShFileOpFlag) to High(TShFileOpFlag) do
    if flag in flags then
      fileOp.fFlags := fileOp.fFlags or CShFileOpFlagMappings[flag];
  Result := (SHFileOperation(fileOp) = 0);
  aborted := fileOp.fAnyOperationsAborted;
end; { DSiCopyFileAnimated }

  {:Creates folder with the unique name under the temporary folder and returns its name.
    @author  Miha-R
    @since   2002-11-25
  }
function DSiCreateTempFolder: string;
var
  GUID: TGUID;
begin
  OleCheck(CoCreateGUID(GUID));
  Result := DSiGetTempPath + GUIDToString(GUID);
  ForceDirectories(Result);
end; { DSiCreateTempFolder }

  {:Deletes files matching file mask.
    @author  gabr
    @since   2002-12-19
  }
procedure DSiDeleteFiles(const folder, fileMask: string);
var
  err: integer;
  folderBk: string;
  S: TSearchRec;
begin
  folderBk := IncludeTrailingBackslash(folder);
  err := FindFirst(folderBk + fileMask, 0, S);
  if err = 0 then
  begin
    repeat
      DSiKillFile(folderBk + S.Name);
      err := FindNext(S);
    until err <> 0;
    FindClose(S);
  end;
end; { DSiDeleteFiles }

{gp}
function DSiDeleteOnReboot(const fileName: string): boolean;
begin
  Result := DSiMoveOnReboot(fileName, '');
end; { DSiDeleteOnReboot }

{gp}
procedure DSiDeleteTree(const folder: string; removeSubdirsOnly: boolean);

  procedure DeleteTree(const folder: string; depth: integer; delete0: boolean);
  var
    err: integer;
    s: TSearchRec;
  begin
    err := FindFirst(IncludeTrailingBackslash(folder) + '*.*', faDirectory, S);
    if err = 0 then
    begin
      repeat
        if (S.Attr and faDirectory) <> 0 then
          if (S.Name <> '.') and (S.Name <> '..') then
            DeleteTree(IncludeTrailingBackslash(folder) + S.Name, depth + 1, delete0);
        err := FindNext(S);
      until err <> 0;
      FindClose(S);
    end;
    if (depth > 0) or delete0 then
      DSiRemoveFolder(folder);
  end; { DeleteTree }

begin { DSiDeleteTree }
  DeleteTree(folder, 0, not removeSubdirsOnly);
end; { DSiDeleteTree }

{gp}
function DSiDeleteWithBatch(const fileName: string; rmDir: boolean): boolean;
  // Idea stollen from the article by Jeffrey Richter, first published in
  // Microsoft Systems Journal, reprinted in Microsoft Developer Network.
  // Simple but effective solution: create batch file that deletes exe and then
  // deletes itself, then run it as an invisible console app with low priority.
var
  bat: Text;
  pi:  TProcessInformation;
  si:  TStartupInfo;
  tmpFile: string;
  winTemp: string;
begin
  Result := False;
  try
    winTemp := DSiGetTempFileName('wt');
    if winTemp <> '' then
    begin
      tmpFile := ChangeFileExt(winTemp, '.bat');
      MoveFile(PChar(winTemp), PChar(tmpFile));
      Assign(bat, tmpFile);
      Rewrite(bat);
      Writeln(bat, ':repeat');
      Writeln(bat, 'del "', fileName, '"');
      Writeln(bat, 'if exist "', fileName, '" goto repeat');
      if rmDir then
        Writeln(bat, 'rmdir "', ExtractFilePath(fileName), '"');
      Writeln(bat, 'del "', tmpFile, '"');
      Close(bat);
      FillChar(si, SizeOf(si), 0);
      si.cb := SizeOf(si);
      si.dwFlags := STARTF_USESHOWWINDOW;
      si.wShowWindow := SW_HIDE;
        {$IFDEF Unicode}UniqueString(tmpFile);{$ENDIF Unicode}
      if (CreateProcess(nil, PChar(tmpFile), nil, nil, False,
        CREATE_SUSPENDED or IDLE_PRIORITY_CLASS, nil,
        PChar(ExtractFilePath(tmpFile)), si, pi)) then
      begin
        SetThreadPriority(pi.hThread, THREAD_PRIORITY_IDLE);
        CloseHandle(pi.hProcess);
        ResumeThread(pi.hThread);
        CloseHandle(pi.hThread);
        Result := True;
      end;
    end;
  except
  end;
end; { DSiDeleteWithBatch }

  {:Wide version of SysUtils.DirectoryExists.
    @author  gabr
    @since   2006-08-14
  }
function DSiDirectoryExistsW(const directory: WideString): boolean;
var
  code: integer;
begin
  code := GetFileAttributesW(PWideChar(directory));
  Result := (code <> -1) and ((FILE_ATTRIBUTE_DIRECTORY and code) <> 0);
end; { DSiDirectoryExistsW }

  {:Try to disable WOW64 file system redirection if running on 64-bit Windows.
    Always succeeds on 32-bit windows.
    @author  gabr
    @since   2009-03-17
  }
function DSiDisableWow64FsRedirection(var oldStatus: pointer): boolean;
begin
  if DSiIsWow64 then
    Result := DSiWow64DisableWow64FsRedirection(oldStatus)
  else
    Result := True;
end; { DSiDisableWow64FsRedirection }

  {:Disconnects mapped letter.
    @author  gabr
    @since   2009-01-28
  }
function DSiDisconnectFromNetworkResource(mappedLetter: char;
  updateProfile: boolean): boolean;
var
  driveName: string;
  flags: cardinal;
begin
  driveName := mappedLetter + ':'#0;
  flags := 0;
  if updateProfile then
    flags := CONNECT_UPDATE_PROFILE;
  Result := (WNetCancelConnection2(PChar(@driveName[1]), flags, True) = NO_ERROR);
end; { DSiDisconnectFromNetworkResource }

{gp}
function DSiEjectMedia(deviceLetter: char): boolean;
var
  cd:  THandle;
  ret: DWORD;
begin
  Result := False;
  cd := CreateFile(PChar('\\.\' + deviceLetter + ':'), GENERIC_READ,
    0, nil, OPEN_EXISTING, 0, 0);
  if cd <> INVALID_HANDLE_VALUE then
  begin
    Result := DeviceIoControl(cd, IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0, ret, nil);
    CloseHandle(cd);
  end;
end; { DSiLoadMedia }

  {:Deletes all files in the folder.
    @author  gabr
    @since   2002-12-19
  }
procedure DSiEmptyFolder(const folder: string);
begin
  DSiDeleteFiles(folder, '*.*');
end; { DSiEmptyFolder }

  {:Empties recycle bin.
    @author  ales
    @since   2002-12-19
  }
function DSiEmptyRecycleBin: boolean;
begin
  Result := DSiSHEmptyRecycleBin(0, nil, SHERB_NOCONFIRMATION or
    SHERB_NOPROGRESSUI or SHERB_NOSOUND) = S_OK;
end; { DSiEmptyRecycleBin }

  {:Enumerates all files matching given mask and attribute and calls callback method for
    each file.
    @returns Number of files enumerated.
    @author  gabr
    @since   2003-06-17
  }
function DSiEnumFiles(const fileMask: string; attr: integer;
  enumCallback: TDSiEnumFilesCallback): integer;
var
  err: integer;
  folder: string;
  S: TSearchRec;
begin
  Result := 0;
  folder := IncludeTrailingBackslash(ExtractFilePath(fileMask));
  err := FindFirst(fileMask, attr, S);
  if err = 0 then
    try
      repeat
        enumCallback(folder + S.Name);
        Inc(Result);
        err := FindNext(S);
      until err <> 0;
    finally
      FindClose(S);
    end;
end; { DSiEnumFiles }

procedure _DSiEnumFilesEx(const folder, fileMask: string; attr: integer;
  enumSubfolders: boolean; enumCallback: TDSiEnumFilesExCallback;
  var totalFiles: integer; var stopEnum: boolean; fileList: TStrings;
  storeFullPath: boolean; currentDepth, maxDepth: integer);
var
  err: integer;
  s: TSearchRec;
begin
  if enumSubfolders and ((maxDepth <= 0) or (currentDepth < maxDepth)) then
  begin
    err := FindFirst(folder + '*.*', faDirectory, S);
    if err = 0 then
      try
        repeat
          if (S.Attr and faDirectory) <> 0 then
            if (S.Name <> '.') and (S.Name <> '..') then
            begin
              if assigned(enumCallback) then
              begin
                enumCallback(folder, S, True, stopEnum);
                if stopEnum then
                  Exit;
              end;
              if assigned(fileList) then
                if storeFullPath then
                  fileList.Add(folder + S.Name + '\')
                else
                  fileList.Add(S.Name + '\');
              _DSiEnumFilesEx(folder + S.Name + '\', fileMask, attr, enumSubfolders,
                enumCallback, totalFiles, stopEnum, fileList, storeFullPath,
                currentDepth + 1, maxDepth);
            end;
          err := FindNext(S);
        until (err <> 0) or stopEnum;
      finally
        FindClose(S);
      end;
  end;
  if stopEnum then
    Exit;
  err := FindFirst(folder + fileMask, attr, S);
  if err = 0 then
    try
      repeat
        if assigned(enumCallback) then
          enumCallback(folder, S, False, stopEnum);
        if assigned(fileList) then
          if storeFullPath then
            fileList.Add(folder + S.Name)
          else
            fileList.Add(S.Name);
        Inc(totalFiles);
        err := FindNext(S);
      until (err <> 0) or stopEnum;
    finally
      FindClose(S);
    end;
end; { _DSiEnumFilesEx }

  {:Enumerates all files matching given mask and attribute and calls callback
    method for each file. Optionally descends into subfolders.
    @returns Number of files (not folders!) enumerated.
    @author  gabr
    @since   2003-06-17
  }
function DSiEnumFilesEx(const fileMask: string; attr: integer;
  enumSubfolders: boolean; enumCallback: TDSiEnumFilesExCallback;
  maxEnumDepth: integer): integer;
var
  folder: string;
  mask: string;
  stopEnum: boolean;
begin
  mask := fileMask;
  folder := ExtractFilePath(mask);
  Delete(mask, 1, Length(folder));
  if folder <> '' then
    folder := IncludeTrailingBackslash(folder);
  Result := 0;
  stopEnum := False;
  _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, enumCallback, Result, stopEnum,
    nil, False, 1, maxEnumDepth);
end; { DSiEnumFilesEx }

  {:Enumerates files (optionally in subfolders) and stores results into caller-provided
    TStrings object.
    @since   2006-05-14
  }
procedure DSiEnumFilesToSL(const fileMask: string; attr: integer;
  fileList: TStrings; storeFullPath: boolean; enumSubfolders: boolean;
  maxEnumDepth: integer);
var
  folder: string;
  mask: string;
  stopEnum: boolean;
  totalFiles: integer;
begin
  fileList.Clear;
  mask := fileMask;
  folder := ExtractFilePath(mask);
  Delete(mask, 1, Length(folder));
  if folder <> '' then
    folder := IncludeTrailingBackslash(folder);
  stopEnum := False;
  _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, nil, totalFiles, stopEnum,
    fileList, storeFullPath, 1, maxEnumDepth);
end; { DSiEnumFilesToSL }

  {:Wide version of SysUtils.FileExists.
    @author  gabr
    @since   2006-08-14
  }
function DSiFileExistsW(const fileName: WideString): boolean;
var
  code: integer;
begin
  code := GetFileAttributesW(PWideChar(fileName));
  Result := (code <> -1) and ((FILE_ATTRIBUTE_DIRECTORY and code) = 0);
end; { DSiFileExistsW }

  {:Checks if fileName extension is equal to the extension parameter.
    Extension can be provided with or without leading period.
    @author  gabr
    @since   2007-06-08
  }
function DSiFileExtensionIs(const fileName, extension: string): boolean; overload;
var
  fExt: string;
begin
  fExt := ExtractFileExt(fileName);
  if (Length(extension) = 0) or (extension[1] <> '.') and (fExt <> '') and
    (fExt[1] = '.') then
    Delete(fExt, 1, 1);
  Result := SameText(fExt, extension);
end; { DSiFileExtensionIs }

  {:Checks if fileName extension is equal to any of the extensions listed in the extension
    array.
    @author  gabr
    @since   2007-06-08
  }
function DSiFileExtensionIs(const fileName: string;
  extension: array of string): boolean;
  overload;
var
  fExtDot: string;
  fExtNoDot: string;
  iExt: integer;
  testExt: string;
begin
  Result  := True;
  fExtDot := ExtractFileExt(fileName);
  fExtNoDot := fExtDot;
  if (fExtDot = '') or (fExtDot[1] <> '.') then
    fExtDot := '.' + fExtDot;
  if (fExtNoDot <> '') and (fExtNoDot[1] = '.') then
    Delete(fExtNoDot, 1, 1);
  for iExt := Low(extension) to High(extension) do
  begin
    testExt := extension[iExt];
    if (Length(testExt) = 0) or (testExt[1] <> '.') then
      if SameText(fExtNoDot, testExt) then
        Exit
      else if SameText(fExtDot, testExt) then
        Exit;
  end;
  Result := False;
end; { DSiFileExtensionIs }

  {:Retrieves file size.
    @returns -1 for unexisting/unaccessible file or file size.
    @author  gabr
    @since   2003-06-17
  }
function DSiFileSize(const fileName: string): int64;
var
  fHandle: DWORD;
begin
  fHandle := CreateFile(PChar(fileName), 0, 0, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);
  if fHandle = INVALID_HANDLE_VALUE then
    Result := -1
  else
    try
      Int64Rec(Result).Lo := GetFileSize(fHandle, @Int64Rec(Result).Hi);
    finally
      CloseHandle(fHandle);
    end;
end; { DSiFileSize }

  {:Wide version of DSiFileSize.
    @returns -1 for unexisting/unaccessible file or file size.
    @author  gabr
    @since   2006-08-14
  }
function DSiFileSizeW(const fileName: WideString): int64;
var
  fHandle: DWORD;
begin
  fHandle := CreateFileW(PWideChar(fileName), 0, 0, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);
  if fHandle = INVALID_HANDLE_VALUE then
    Result := -1
  else
    try
      Int64Rec(Result).Lo := GetFileSize(fHandle, @Int64Rec(Result).Hi);
    finally
      CloseHandle(fHandle);
    end;
end; { DSiFileSizeW }

  {:Calculates size of all files in a specified folder.
    @author  radicalb, gabr
    @since   2007-05-30
  }
function DSiGetFolderSize(const folder: string; includeSubfolders: boolean): int64;
var
  err: integer;
  folderBk: string;
  rec: TSearchRec;
begin
  Result := 0;
  folderBk := IncludeTrailingBackslash(folder);
  err := FindFirst(folderBk + '*.*', faAnyFile, rec);
  if err = 0 then
    try
      repeat
        Inc(Result, rec.Size);
        if includeSubfolders and ((rec.Attr and faDirectory) > 0) and
          (rec.Name <> '.') and (rec.Name <> '..') then
          Inc(Result, DSiGetFolderSize(folderBk + rec.Name, True));
        err := FindNext(rec);
      until (err <> 0);
    finally
      FindClose(rec);
    end;
end; { DSiGetFolderSize }

  {:Returns one of the file times - creation time, last access time, last write time.
    Returns 0 if file cannot be accessed.
    @author  Lee_Nover
    @since   2006-03-01
  }
function DSiGetFileTime(const fileName: string; whatTime: TDSiFileTime): TDateTime;
var
  creationTime: TDateTime;
  lastAccessTime: TDateTime;
  lastModificationTime: TDateTime;
begin
  if not DSiGetFileTimes(fileName, creationTime, lastAccessTime,
    lastModificationTime) then
    Result := 0
  else
    case whatTime of
      ftCreation: Result := creationTime;
      ftLastAccess: Result := lastAccessTime;
      ftLastModification: Result := lastModificationTime;
      else
        raise Exception.Create('DSiGetFileTime: Invalid time selector');
    end;
end; { DSiGetFileTime }

  {:Returns file creation, last access and last write time.
    @author  gabr
    @since   2006-12-20
  }
function DSiGetFileTimes(const fileName: string;
  var creationTime, lastAccessTime, lastModificationTime: TDateTime): boolean;
var
  fileHandle: cardinal;
  fsCreationTime: TFileTime;
  fsLastAccessTime: TFileTime;
  fsLastModificationTime: TFileTime;
begin
  Result := False;
  fileHandle := CreateFile(PChar(fileName), GENERIC_READ, FILE_SHARE_READ,
    nil, OPEN_EXISTING, 0, 0);
  if fileHandle <> INVALID_HANDLE_VALUE then
    try
      Result :=
        GetFileTime(fileHandle, @fsCreationTime, @fsLastAccessTime,
        @fsLastModificationTime) and DSiFileTimeToDateTime(
        fsCreationTime, creationTime) and DSiFileTimeToDateTime(
        fsLastAccessTime, lastAccessTime) and DSiFileTimeToDateTime(
        fsLastModificationTime, lastModificationTime);
    finally
      CloseHandle(fileHandle);
    end;
end; { DSiGetFileTimes }

  {:Returns the long pathname representation.
    @author  Lee_Nover
    @since   2006-03-01
  }
function DSiGetLongPathName(const fileName: string): string;
begin
  if not assigned(GGetLongPathName) then
    GGetLongPathName := DSiGetProcAddress('kernel32.dll',
      'GetLongPathName' + CAPISuffix);
  if assigned(GGetLongPathName) then
  begin
    SetLength(Result, MAX_PATH);
    SetLength(Result, GGetLongPathName(PChar(fileName), PChar(Result),
      Length(Result)));
  end
  else
  begin
    Result := '';
    SetLastError(ERROR_NOT_SUPPORTED);
  end;
end; { DSiGetLongPathName }

  {:Returns information on mapped network resource.
    @author  gabr
    @since   2009-01-28
  }
function DSiGetNetworkResource(mappedLetter: char; var networkResource: string;
  var connectionIsAvailable: boolean): boolean;
var
  bufferSize: cardinal;
  driveName:  string;
  remoteName: PChar;
  wnetResult: integer;
begin
  connectionIsAvailable := False;
  networkResource := '';
  driveName  := mappedLetter + ':';
  wnetResult := GetDriveType(PChar(driveName + '\'));
  if (wnetResult <> DRIVE_REMOTE) and (wnetResult <> DRIVE_NO_ROOT_DIR) then
    Result := True
  else
  begin
    bufferSize := MAX_PATH * SizeOf(char);
    GetMem(remoteName, bufferSize + SizeOf(char));
    try
      wnetResult := WNetGetConnection(PChar(driveName), remoteName, bufferSize);
      if wnetResult = ERROR_MORE_DATA then
      begin
        FreeMem(remoteName);
        GetMem(remoteName, bufferSize);
        wnetResult := WNetGetConnection(PChar(driveName), remoteName, bufferSize);
      end;
      Result := (wnetResult = NO_ERROR) or (wnetResult = ERROR_CONNECTION_UNAVAIL);
      if Result then
      begin
        connectionIsAvailable := (wnetResult = NO_ERROR);
        networkResource := Trim(StrPas(PChar(remoteName)));
      end;
    finally
      FreeMem(remoteName);
    end;
  end;
end; { DSiGetNetworkResource }

  {:Converts SUBSTed drive letter into true path.
    Returns empty string if letter does not belog to a SUBSTed drive.
    @author  gabr
    @since   2009-10-20
  }
function DSiGetSubstDrive(mappedLetter: char): string;
var
  buffer: PChar;
  bufferSize: integer;
  device: string;
begin
  Result := '';
  device := mappedLetter + ':';
  bufferSize := 256;
  GetMem(buffer, bufferSize * SizeOf(char));
  try
    repeat
      if QueryDosDevice(PChar(device), buffer, bufferSize - 1) = 0 then
      begin
        if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
          break //repeat
        else
        begin
          FreeMem(buffer);
          bufferSize := 2 * bufferSize;
          GetMem(buffer, bufferSize * SizeOf(char));
        end;
      end
      else
      begin
        device := string(buffer);
        if Copy(device, 1, 4) = '\??\' then
        begin
          Result := device;
          Delete(Result, 1, 4);
        end;
        break; //repeat
      end;
    until False;
  finally
    FreeMem(buffer);
  end;
end; { DSiGetSubstDrive }

  {:Converts SUBSTed path into true path.
    Returns original path if it does not lie on a SUBSTed drive.
    @author  gabr
    @since   2009-10-20
  }
function DSiGetSubstPath(const path: string): string;
var
  origPath: string;
begin
  Result := path;
  if Length(Result) < 2 then
    Exit;
  if path[2] = ':' then
  begin
    origPath := DSiGetSubstDrive(path[1]);
    if origPath <> '' then
    begin
      Delete(Result, 1, 2);
      Result := origPath + Result;
    end;
  end;
end; { DSiGetSubstPath }

  {:Returns temporary file name, either in the specified path or in the default temp path
    (if 'tempPath' is empty).
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetTempFileName(const prefix, tempPath: string): string;
var
  tempFileName: PChar;
  usePrefix: string;
  useTempPath: string;
begin
  Result := '';
  GetMem(tempFileName, MAX_PATH * SizeOf(char));
  try
    if tempPath = '' then
      useTempPath := DSiGetTempPath
    else
    begin
      useTempPath := tempPath;
      UniqueString(useTempPath);
    end;
    usePrefix := prefix;
    UniqueString(usePrefix);
    if GetTempFileName(PChar(useTempPath), PChar(usePrefix), 0, tempFileName) <> 0 then
      Result := StrPas(tempFileName)
    else
      Result := '';
  finally
    FreeMem(tempFileName);
  end;
end; { DSiGetTempFileName }

  {:Returns path designated for temporary files.
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetTempPath: string;
var
  bufSize:  DWORD;
  tempPath: PChar;
begin
  bufSize := GetTempPath(0, nil);
  GetMem(tempPath, bufSize * SizeOf(char));
  try
    GetTempPath(bufSize, tempPath);
    Result := StrPas(tempPath);
  finally
    FreeMem(tempPath);
  end;
end; { DSiGetTempPath }

  {:Returns unique file name with the specified extension.
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetUniqueFileName(const extension: string): string;
var
  GUID: TGUID;
begin
  OleCheck(CoCreateGUID(GUID));
  Result := Copy(GUIDToString(GUID), 2, 36) + Extension;
end; { DSiGetUniqueFileName }

  {:Checks if NTFS file is compressed.
    @author  gabr
    @since   2006-08-14
  }
function DSiIsFileCompressed(const fileName: string): boolean;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then //only NT can compress files
    Result := False
  else
    Result := (GetFileAttributes(PChar(fileName)) and FILE_ATTRIBUTE_COMPRESSED) =
      FILE_ATTRIBUTE_COMPRESSED;
end; { DSiIsFileCompressed }

  {:Wide version of DSiIsFileCompressed.
    @author  gabr
    @since   2006-08-14
  }
function DSiIsFileCompressedW(const fileName: WideString): boolean;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then //only NT can compress files
    Result := False
  else
    Result := (GetFileAttributesW(PWideChar(fileName)) and FILE_ATTRIBUTE_COMPRESSED) =
      FILE_ATTRIBUTE_COMPRESSED;
end; { DSiIsFileCompressedW }

  {:Deletes file, even if it is readonly.
    @author  gabr
    @since   2002-11-25
  }
function DSiKillFile(const fileName: string): boolean;
var
  oldAttr: DWORD;
begin
  if not FileExists(fileName) then
    Result := True
  else
  begin
    oldAttr := GetFileAttributes(PChar(fileName));
    SetFileAttributes(PChar(fileName), 0);
    Result := DeleteFile(fileName);
    if not Result then
      SetFileAttributes(PChar(fileName), oldAttr);
  end;
end; { DSiKillFile }

{gp}
function DSiLoadMedia(deviceLetter: char): boolean;
var
  cd:  THandle;
  ret: DWORD;
begin
  Result := False;
  cd := CreateFile(PChar('\\.\' + deviceLetter + ':'), GENERIC_READ,
    0, nil, OPEN_EXISTING, 0, 0);
  if cd <> INVALID_HANDLE_VALUE then
  begin
    Result := DeviceIoControl(cd, IOCTL_STORAGE_LOAD_MEDIA, nil, 0, nil, 0, ret, nil);
    CloseHandle(cd);
  end;
end; { DSiLoadMedia }

 ///<summary>Moves a file to another file, even if target exists.</summary>
 ///<author>gabr</author>
 ///<since>2007-07-24</since>
function DSiMoveFile(const srcName, destName: string; overwrite: boolean): boolean;
var
  flags: DWORD;
begin
  Result := False;
  if DSiIsWinNT then
  begin
    flags := MOVEFILE_COPY_ALLOWED;
    if overwrite then
      flags := flags or MOVEFILE_REPLACE_EXISTING;
    Result := MoveFileEx(PChar(srcName), PChar(destName), flags);
  end
  else
  begin
    if overwrite and FileExists(destName) then
      if not DeleteFile(destName) then
        Exit;
    Result := MoveFile(PChar(srcName), PChar(destName));
  end;
end; { DSiMoveFile }

{gp}
function DSiMoveOnReboot(const srcName, destName: string): boolean;
var
  wfile: string;
  winit: Text;
  wline: string;
  cont: TStringList;
  i: integer;
  found: boolean;
  dest: PChar;
begin
  if destName = '' then
    dest := nil
  else
    dest := PChar(destName);
  if DSiIsWinNT then
    Result := MoveFileEx(PChar(srcName), dest, MOVEFILE_DELAY_UNTIL_REBOOT)
  else
    Result := False;
  if not Result then
  begin
    // not NT, write a Rename entry to WININIT.INI
    wfile := DSiGetWindowsFolder + '\wininit.ini';
    if FileOpenSafe(wfile, winit, 500, 120{one minute}) then
      try
        cont := TStringList.Create;
        try
          Reset(winit);
          while not EOF(winit) do
          begin
            Readln(winit, wline);
            cont.Add(wline);
          end; //while
          if destName = '' then
            wline := 'NUL=' + srcName
          else
            wline := destName + '=' + srcName;
          found := False;
          for i := 0 to cont.Count - 1 do
            if UpperCase(cont[i]) = '[RENAME]' then
            begin
              cont.Insert(i + 1, wline);
              found := True;
              break;
            end; //for
          if not found then
          begin
            cont.Add('[Rename]');
            cont.Add(wline);
          end;
          Rewrite(winit);
          for i := 0 to cont.Count - 1 do
            Writeln(winit, cont[i]);
          Result := True;
        finally
          cont.Free;
        end;
      finally
        Close(winit);
      end;
  end;
end; { DSiMoveOnReboot }

  {:Deletes all files and folders in the specified folder (recursively), then deletes the
    folder.
    @author  gabr
    @since   2002-12-19
  }
procedure DSiRemoveFolder(const folder: string);
begin
  DSiEmptyFolder(folder);
  if DirectoryExists(folder) then
    RemoveDir(folder);
end; { DSiRemoveFolder }

  {:Try to revert WOW64 file system redirection status if running on 64-bit Windows.
    Always succeeds on 32-bit windows.
    @author  gabr
    @since   2009-03-17
  }
function DSiRevertWow64FsRedirection(const oldStatus: pointer): boolean;
begin
  if DSiIsWow64 then
    Result := DSiWow64RevertWow64FsRedirection(oldStatus)
  else
    Result := True;
end; { DSiRevertWow64FsRedirection }

  {:Sets one of the file times - creation time, last access time, last write time.
    @author  gabr
    @since   2012-02-06
  }
function DSiSetFileTime(const fileName: string; dateTime: TDateTime;
  whatTime: TDSiFileTime): boolean;
var
  creationTime: TDateTime;
  lastAccessTime: TDateTime;
  lastModificationTime: TDateTime;
begin
  Result := DSiGetFileTimes(fileName, creationTime, lastAccessTime,
    lastModificationTime);
  if not Result then
    Exit;
  case whatTime of
    ftCreation: creationTime := dateTime;
    ftLastAccess: lastAccessTime := dateTime;
    ftLastModification: lastModificationTime := dateTime;
    else
      raise Exception.CreateFmt('DSiSetFileTime: Unexpected whatTime: %d',
        [Ord(whatTime)]);
  end;
  Result := DSiSetFileTimes(fileName, creationTime, lastAccessTime,
    lastModificationTime);
end; { DSiSetFileTime }

  {:Setsfile creation, last access and last write time.
    @author  gabr
    @since   2012-02-06
  }
function DSiSetFileTimes(const fileName: string;
  creationTime, lastAccessTime, lastModificationTime: TDateTime): boolean;
var
  fileHandle: cardinal;
  fsCreationTime: TFileTime;
  fsLastAccessTime: TFileTime;
  fsLastModificationTime: TFileTime;
begin
  Result := False;
  fileHandle := CreateFile(PChar(fileName), GENERIC_READ + GENERIC_WRITE,
    0, nil, OPEN_EXISTING, 0, 0);
  if fileHandle <> INVALID_HANDLE_VALUE then
    try
      Result :=
        DSiDateTimeToFileTime(creationTime, fsCreationTime) and
        DSiDateTimeToFileTime(lastAccessTime, fsLastAccessTime) and
        DSiDateTimeToFileTime(lastModificationTime, fsLastModificationTime) and
        SetFileTime(fileHandle, @fsCreationTime, @fsLastAccessTime,
        @fsLastModificationTime);
    finally
      CloseHandle(fileHandle);
    end;
end; { DSiSetFileTimes }

{ales}
function DSiShareFolder(const folder, shareName, comment: string): boolean;
var
  ntComment: WideString;
  ntFolder:  WideString;
  ntShareName: WideString;
  paramError: integer;
  shareInfo9x: SHARE_INFO_50_9x;
  shareInfoNT: SHARE_INFO_2_NT;
  w9xShareName: string;
begin
  if folder = '' then
    raise Exception.Create('DSiShareFolder: empty folder');
  if shareName = '' then
    raise Exception.Create('DSiShareFolder: empty share name');
  if DSiIsWinNT then
  begin
    ntFolder  := folder;
    ntShareName := shareName;
    ntComment := comment;
    with ShareInfoNT do
    begin
      shi2_NetName := PWideChar(ntShareName);
      shi2_Type := STYPE_DISKTREE;
      shi2_Remark := PWideChar(ntComment);
      shi2_Permissions := 0;
      shi2_Max_Uses := -1;
      shi2_Current_Uses := 0;
      shi2_Path := PWideChar(ntFolder);
      shi2_Passwd := nil;
    end;
    ParamError := 0;
    Result := (DSiNTNetShareAdd(nil, 2, @ShareInfoNT, paramError) = 0);
  end
  else
  begin
    with ShareInfo9x do
    begin
      FillChar(shi50_NetName, 13, 0);
      w9xShareName := Copy(shareName, 1, 13);
      Move(w9xShareName[1], shi50_NetName[1], Length(w9xShareName));
      shi50_Type  := STYPE_DISKTREE;
      shi50_Remark := PChar(comment);
      shi50_rw_password[1] := #0;
      shi50_ro_password[1] := #0;
      shi50_flags := SHI50F_FULL;
      shi50_Path  := PChar(AnsiUpperCase(folder));
    end;
    Result := (DSi9xNetShareAdd(nil, 50, @ShareInfo9x, SizeOf(SHARE_INFO_50_9x)) = 0);
  end;
end; { DSiShareFolder }

  {:Uncompresses file on NTFS filesystem.
    @author  gabr
    @since   2006-08-14
  }
function DSiUncompressFile(fileHandle: THandle): boolean;
begin
  Result := DSiSetCompression(fileHandle, COMPRESSION_FORMAT_NONE);
end; { DSiUncompressFile }

{ales}
function DSiUnShareFolder(const shareName: string): boolean;
var
  ntShareName: WideString;
begin
  if DSiIsWinNT then
  begin
    ntShareName := shareName;
    Result := (DSiNTNetShareDel(nil, PWideChar(ntShareName), 0) = 0);
  end
  else
    Result := (DSi9xNetShareDel(nil, PChar(shareName), 0) = 0);
end; { DSiUnShareFolder }

{ Processes }

const
  DESKTOP_ALL = DESKTOP_READOBJECTS or DESKTOP_CREATEWINDOW or
    DESKTOP_CREATEMENU or DESKTOP_HOOKCONTROL or DESKTOP_JOURNALRECORD or
    DESKTOP_JOURNALPLAYBACK or DESKTOP_ENUMERATE or DESKTOP_WRITEOBJECTS or
    DESKTOP_SWITCHDESKTOP or STANDARD_RIGHTS_REQUIRED;

  WINSTA_ALL = WINSTA_ENUMDESKTOPS or WINSTA_READATTRIBUTES or
    WINSTA_ACCESSCLIPBOARD or WINSTA_CREATEDESKTOP or WINSTA_WRITEATTRIBUTES or
    WINSTA_ACCESSGLOBALATOMS or WINSTA_EXITWINDOWS or WINSTA_ENUMERATE or
    WINSTA_READSCREEN or STANDARD_RIGHTS_REQUIRED;

  GENERIC_ACCESS = GENERIC_READ or GENERIC_WRITE or GENERIC_EXECUTE or GENERIC_ALL;

  HEAP_ZERO_MEMORY = 8;
  ACL_REVISION = 2;
  ACCESS_ALLOWED_ACE_TYPE = 0;
  CONTAINER_INHERIT_ACE = 2;
  INHERIT_ONLY_ACE = 8;
  OBJECT_INHERIT_ACE = 1;
  NO_PROPAGATE_INHERIT_ACE = 4;
  SE_GROUP_LOGON_ID = $C0000000;

type
  ACL_SIZE_INFORMATION = record
    AceCount: DWORD;
    AclBytesInUse: DWORD;
    AclBytesFree: DWORD;
  end;

  ACE_HEADER = record
    AceType:  byte;
    AceFlags: byte;
    AceSize:  word;
  end;
  PACE_HEADER = ^ACE_HEADER;

  ACCESS_ALLOWED_ACE = record
    Header: ACE_HEADER;
    Mask: ACCESS_MASK;
    SidStart: DWORD;
  end;
  PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;

function DSiAddAceToDesktop(desktop: HDESK; sid: PSID): boolean;
var
  aclSizeInfo: ACL_SIZE_INFORMATION;
  dacl: PACL;
  daclExists: longbool;
  daclPresent: longbool;
  iAce: integer;
  newAcl: PACL;
  newAclSize: DWORD;
  newSecDescr: PSECURITY_DESCRIPTOR;
  sdSize: DWORD;
  sdSizeNeeded: DWORD;
  secDescr: PSECURITY_DESCRIPTOR;
  secInfo: SECURITY_INFORMATION;
  skipAdd: boolean;
  tempAce: PACE_HEADER;
begin
  Result  := False;
  secDescr := nil;
  newSecDescr := nil;
  newAcl  := nil;
  secInfo := DACL_SECURITY_INFORMATION;
  sdSize  := 0;
  try
    if not GetUserObjectSecurity(desktop, secInfo, secDescr, sdSize, sdSizeNeeded) then
    begin
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
        Exit;
      secDescr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, sdSizeNeeded);
      if secDescr = nil then
        Exit;
      newSecDescr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, sdSizeNeeded);
      if newSecDescr = nil then
        Exit;
      sdSize := sdSizeNeeded;
      if not GetUserObjectSecurity(desktop, secInfo, secDescr,
        sdSize, sdSizeNeeded) then
        Exit;
    end;
    if not InitializeSecurityDescriptor(newSecDescr, SECURITY_DESCRIPTOR_REVISION) then
      Exit;
    if not GetSecurityDescriptorDacl(secDescr, daclPresent, dacl, daclExists) then
      Exit;
    ZeroMemory(@aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION));
    aclSizeInfo.AclBytesInUse := SizeOf(ACL);
    if assigned(dacl) then
      if not GetAclInformation(dacl^, @aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION),
        AclSizeInformation) then
        Exit;
    newAclSize := aclSizeInfo.AclBytesInUse + SizeOf(ACCESS_ALLOWED_ACE) +
      GetLengthSid(sid) - SizeOf(DWORD);
    newAcl := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, newAclSize);
    if (newAcl = nil) or (not InitializeAcl(newAcl^, newAclSize, ACL_REVISION)) then
      Exit;
    skipAdd := False;
    if daclPresent then
      for iAce := 0 to aclSizeInfo.AceCount - 1 do
      begin
        if not (GetAce(dacl^, iAce, pointer(tempAce)) and
          AddAce(newAcl^, ACL_REVISION, MAXDWORD, tempAce, tempAce.AceSize)) then
          Exit;
        if (tempAce.AceType = ACCESS_ALLOWED_ACE_TYPE) and
          EqualSID(@PACCESS_ALLOWED_ACE(tempAce)^.SidStart, sid) then
          skipAdd := True;
      end// Copy the ACEs to the new ACL.
    ;
    if not skipAdd then
      if not (AddAccessAllowedAce(newAcl^, ACL_REVISION, DESKTOP_ALL, sid) and
        SetSecurityDescriptorDacl(newSecDescr, True, newAcl, False) and
        SetUserObjectSecurity(desktop, secInfo, newSecDescr)) then
        Exit;
    Result := True;
  finally
    if assigned(newAcl) then
      HeapFree(GetProcessHeap, 0, newAcl);
    if assigned(secDescr) then
      HeapFree(GetProcessHeap, 0, secDescr);
    if assigned(newSecDescr) then
      HeapFree(GetProcessHeap, 0, newSecDescr);
  end;
end; { DSiAddAceToDesktop }

function DSiAddAceToWindowStation(station: HWINSTA; sid: PSID): boolean;
var
  ace:  ^ACCESS_ALLOWED_ACE;
  aclSizeInfo: ACL_SIZE_INFORMATION;
  dacl: PACL;
  daclExists: longbool;
  daclPresent: longbool;
  iAce: integer;
  newAcl: PACL;
  newAclSize: DWORD;
  newSecDecr: PSECURITY_DESCRIPTOR;
  reqSdSize: DWORD;
  sdSize: DWORD;
  secDescr: PSECURITY_DESCRIPTOR;
  secInfo: SECURITY_INFORMATION;
  skipAdd: boolean;
  tempAce: PACE_HEADER;
begin
  Result := False;
  secInfo := DACL_SECURITY_INFORMATION;
  ace := nil;
  secDescr := nil;
  sdSize := 0;
  newAcl := nil;
  newSecDecr := nil;
  try
    if not GetUserObjectSecurity(station, secInfo, secDescr, sdSize, reqSdSize) then
    begin
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
        Exit;
      secDescr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, reqSdSize);
      if secDescr = nil then
        Exit;
      newSecDecr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, reqSdSize);
      if newSecDecr = nil then
        Exit;
      sdSize := reqSdSize;
      if not GetUserObjectSecurity(station, secInfo, secDescr, sdSize, reqSdSize) then
        Exit;
    end;
    if not InitializeSecurityDescriptor(newSecDecr, SECURITY_DESCRIPTOR_REVISION) then
      Exit;
    if not GetSecurityDescriptorDacl(secDescr, daclPresent, dacl, daclExists) then
      Exit;
    ZeroMemory(@aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION));
    aclSizeInfo.AclBytesInUse := SizeOf(ACL);
    if dacl <> nil then
      if not GetAclInformation(dacl^, @aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION),
        AclSizeInformation) then
        Exit;
    newAclSize := aclSizeInfo.AclBytesInUse + (2 * SizeOf(ACCESS_ALLOWED_ACE)) +
      (2 * GetLengthSid(sid)) - (2 * SizeOf(DWORD));
    newAcl := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, newAclSize);
    if newAcl = nil then
      Exit;
    if not InitializeAcl(newAcl^, newAclSize, ACL_REVISION) then
      Exit;
    skipAdd := False;
    if daclPresent then
      for iAce := 0 to aclSizeInfo.AceCount - 1 do
      begin
        if not (GetAce(dacl^, iAce, pointer(tempAce)) and
          AddAce(newAcl^, ACL_REVISION, MAXDWORD, tempAce, tempAce.AceSize)) then
          Exit;
        if (tempAce.AceType = ACCESS_ALLOWED_ACE_TYPE) and
          EqualSID(@PACCESS_ALLOWED_ACE(tempAce)^.SidStart, sid) then
          skipAdd := True;
      end;
    if not skipAdd then
    begin
      ace := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY,
        SizeOf(ACCESS_ALLOWED_ACE) + GetLengthSid(sid) - SizeOf(DWORD));
      if ace = nil then
        Exit;
      ace.Header.AceType := ACCESS_ALLOWED_ACE_TYPE;
      ace.Header.AceFlags :=
        CONTAINER_INHERIT_ACE or INHERIT_ONLY_ACE or OBJECT_INHERIT_ACE;
      ace.Header.AceSize := SizeOf(ACCESS_ALLOWED_ACE) + GetLengthSid(sid) -
        SizeOf(DWORD);
      ace.Mask := GENERIC_ACCESS;
      if not (CopySid(GetLengthSid(sid), @ace.SidStart, sid) and
        AddAce(newAcl^, ACL_REVISION, MAXDWORD, ace, ace.Header.AceSize)) then
        Exit;
      ace.Header.AceFlags := NO_PROPAGATE_INHERIT_ACE;
      ace.Mask := WINSTA_ALL;
      if not (AddAce(newAcl^, ACL_REVISION, MAXDWORD, ace, ace.Header.AceSize) and
        SetSecurityDescriptorDacl(newSecDecr, True, newAcl, False) and
        SetUserObjectSecurity(station, secInfo, newSecDecr)) then
        Exit;
    end;
    Result := True;
  finally
    if assigned(ace) then
      HeapFree(GetProcessHeap, 0, ace);
    if assigned(newAcl) then
      HeapFree(GetProcessHeap, 0, newAcl);
    if assigned(secDescr) then
      HeapFree(GetProcessHeap, 0, secDescr);
    if assigned(newSecDecr) then
      HeapFree(GetProcessHeap, 0, newSecDecr);
  end;
end; { DSiAddAceToWindowStation }

  {:Convert affinity mask into a string representation (0..9, A..V).
    @author  gabr
    @since   2003-11-14
  }
function DSiAffinityMaskToString(affinityMask: DWORD): string;
var
  idxID: integer;
begin
  Result := '';
  for idxID := 1 to 32 do
  begin
    if Odd(affinityMask) then
      Result := Result + DSiCPUIDs[idxID];
    affinityMask := affinityMask shr 1;
  end;
end; { DSiAffinityMaskToString }

  {:Converts 'current process' pseudo-handle into a real handle belonging to the same
    process. Don't forget to close the returned handle!
    @author  gabr
    @since   2009-03-16
  }
function DSiGetCurrentProcessHandle: THandle;
begin
  DuplicateHandle(GetCurrentProcess, GetCurrentProcess, GetCurrentProcess, @Result, 0,
    False, DUPLICATE_SAME_ACCESS);
end; { DSiGetCurrentProcessHandle }

  {:Converts 'current thread' pseudo-handle into a real handle belonging to the same
    process. Don't forget to close the returned handle!
    @author  gabr
    @since   2009-03-16
  }
function DSiGetCurrentThreadHandle: THandle;
begin
  DuplicateHandle(GetCurrentProcess, GetCurrentThread, GetCurrentProcess, @Result, 0,
    False, DUPLICATE_SAME_ACCESS);
end; { DSiGetCurrentThreadHandle }

  {:Enables specified privilege for the current process.
    @author  Gre-Gor
    @since   2004-02-12
  }
function DSiEnablePrivilege(const privilegeName: string): boolean;
var
  hToken: THandle;
  retLength: DWORD;
  tokenPriv: TTokenPrivileges;
begin
  if not DSiIsWinNT then
    Result := True
  else
  begin
    Result := False;
    if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
      TOKEN_QUERY, hToken) then
      Exit;
    try
      tokenPriv.PrivilegeCount := 1;
      if not LookupPrivilegeValue(nil, PChar(privilegeName),
        tokenPriv.Privileges[0].Luid) then
        Exit;
      tokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      if not AdjustTokenPrivileges(hToken, False, tokenPriv,
        SizeOf(tokenPriv), nil, retLength) then
        Exit;
      Result := True;
    finally
      CloseHandle(hToken);
    end;
  end;
end; { DSiEnablePrivilege }

  {:Executes an external program.
    @author  Miha-R
    @returns MaxInt if CreateProcess fails or process exit code if wait is specified or 0
             in other cases.
    @since   2002-11-25
  }
function DSiExecute(const commandLine: string; visibility: integer;
  const workDir: string; wait: boolean): cardinal;
var
  processInfo: TProcessInformation;
  startupInfo: TStartupInfo;
  tmpCmdLine:  string;
  useWorkDir:  string;
begin
  if workDir = '' then
    GetDir(0, useWorkDir)
  else
    useWorkDir := workDir;
  FillChar(startupInfo, SizeOf(startupInfo), #0);
  startupInfo.cb := SizeOf(startupInfo);
  startupInfo.dwFlags := STARTF_USESHOWWINDOW;
  startupInfo.wShowWindow := visibility;
  tmpCmdLine := commandLine;
    {$IFDEF Unicode}UniqueString(tmpCmdLine);{$ENDIF Unicode}
  if not CreateProcess(nil, PChar(tmpCmdLine), nil, nil, False,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, PChar(useWorkDir),
    startupInfo, processInfo) then
    Result := MaxInt
  else
  begin
    if wait then
    begin
      WaitForSingleObject(processInfo.hProcess, INFINITE);
      GetExitCodeProcess(processInfo.hProcess, Result);
    end
    else
      Result := 0;
    CloseHandle(processInfo.hProcess);
    CloseHandle(processInfo.hThread);
  end;
end; { DSiExecute }


  {:Simplified DSiExecuteAsUser.
    @author  gabr
    @returns Returns MaxInt if any Win32 API fails or process exit code if wait is
             specified or 0 in other cases.
    @since   2010-06-18
  }
function DSiExecuteAsUser(const commandLine, username, password: string;
  var winErrorCode: cardinal; const domain: string; visibility: integer;
  const workDir: string; wait: boolean): cardinal;
var
  processInfo: TProcessInformation;
begin
  Result := DSiExecuteAsUser(commandLine, username, password,
    winErrorCode, processInfo, domain, visibility, workDir, wait, nil);
  if (Result <> cardinal(MaxInt)) and wait then
  begin
    DSiCloseHandleAndNull(processInfo.hProcess);
    DSiCloseHandleAndNull(processInfo.hThread);
  end;
end; { DSiExecuteAsUser }

  {:Executes process as another user. Same as DSiExecute on 9x architecture.
    @author  gabr
    @returns Returns MaxInt if any Win32 API fails or process exit code if wait is
             specified or 0 in other cases.
    @since   2002-12-19
  }
function DSiExecuteAsUser(const commandLine, username, password: string;
  var winErrorCode: cardinal; var processInfo: TProcessInformation;
  const domain: string; visibility: integer; const workDir: string;
  wait: boolean; startInfo: PStartupInfo): cardinal;
var
  dwSize: DWORD;
  hProcess: THandle;
  interDesktop: HDESK;
  interWindowStation: HWINSTA;
  lastError: DWORD;
  logonHandle: THandle;
  logonSID: PSID;
  lpvEnv: pointer;
  origWindowStation: HWINSTA;
  startupInfo: TStartupInfo;
  startupInfoW: TStartupInfoW;
  szUserProfile: PWideChar;
  tmpCmdLine: string;
  useStartInfo: pointer;
  workDirW: WideString;
begin
  Result := MaxInt;
  logonHandle := 0;
  lpvEnv := nil;
  szUserProfile := nil;
  origWindowStation := 0;
  logonSID := nil;
  interWindowStation := 0;
  interDesktop := 0;
  logonHandle := 0;
  hProcess := 0;
  try
    if not DSiIsWinNT then
      Result := DSiExecute(commandLine, visibility, workDir, wait)
    else
      try
        if username <> '' then
        begin
          if not DSiLogonAs(username, password, domain, logonHandle) then
            Exit;
        end
        else
        begin
          hProcess := OpenProcess(STANDARD_RIGHTS_REQUIRED or
            SYNCHRONIZE or $FFF, True, GetCurrentProcessID);
          if hProcess = 0 then
            Exit;
          if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or
            TOKEN_QUERY, logonHandle) then
            Exit;
        end;

        if workDir <> '' then
          workDirW := workDir
        else
        begin
          GetMem(szUserProfile, SizeOf(widechar) * 257);
          dwSize := 256;
          if not DSiGetUserProfileDirectoryW(logonHandle, szUserProfile, dwSize) then
            Exit;
          if workDir = '' then
            workDirW := szUserProfile;
        end;

        origWindowStation := GetProcessWindowStation;
        if origWindowStation = 0 then
          Exit;
        interWindowStation :=
          OpenWindowStation('winsta0', False, READ_CONTROL or WRITE_DAC);
        if interWindowStation = 0 then
          Exit;
        if not SetProcessWindowStation(interWindowStation) then
          Exit;
        interDesktop := OpenDesktop('default', 0, False, READ_CONTROL or
          WRITE_DAC or DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS);
        if (not SetProcessWindowStation(origWindowStation)) or
          (interDesktop = 0) or (not DSiGetLogonSID(logonHandle, logonSID)) then
          Exit;
        if (not assigned(logonSID)) or
          (not DSiAddAceToWindowStation(interWindowStation, logonSID)) or
          (not DSiAddAceToDesktop(interDesktop, logonSID)) then
          Exit;

        FillChar(startupInfo, SizeOf(startupInfo), #0);
        startupInfo.cb := SizeOf(startupInfo);
        startupInfo.dwFlags := STARTF_USESHOWWINDOW;
        startupInfo.lpDesktop := PChar('winsta0\default');
        startupInfo.wShowWindow := visibility;
        if username = '' then
        begin
          useStartInfo := startInfo;
          if not assigned(useStartInfo) then
            useStartInfo := @startupInfo;
          tmpCmdLine := commandLine;
            {$IFDEF Unicode}UniqueString(tmpCmdLine);{$ENDIF Unicode}
          if CreateProcess(nil, PChar(tmpCmdLine), nil, nil, False,
            CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
            PChar(string(workDirW)), PStartupInfo(useStartInfo)^, processInfo)
          then
            Result := 0;
        end
        else
        begin
          // Impersonate client to ensure access to executable file.
          if (not ImpersonateLoggedOnUser(logonHandle)) then
            Exit;
          try
            useStartInfo := startInfo;
            if not assigned(useStartInfo) then
              useStartInfo := @startupInfo;
            tmpCmdLine := commandLine;
              {$IFDEF Unicode}UniqueString(tmpCmdLine);{$ENDIF Unicode}
            if DSiCreateProcessAsUser(logonHandle, nil, PChar(tmpCmdLine),
              nil, nil, False, {CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS}
              CREATE_DEFAULT_ERROR_MODE, nil, PChar(string(workDirW)),
              PStartupInfo(useStartInfo)^, processInfo) then
              Result := 0;
            lastError := GetLastError;
          finally
            if (username <> '') then
              RevertToSelf;
          end;
          SetLastError(lastError);
        end;

        if (Result <> 0) and (GetLastError = ERROR_PRIVILEGE_NOT_HELD) and
          (username <> '') then
        begin
          if not DSiCreateEnvironmentBlock(lpvEnv, logonHandle, True) then
            Exit;
          Assert(SizeOf(TStartupInfoA) = SizeOf(TStartupInfoW));
          Move(useStartInfo^, startupInfoW, SizeOf(TStartupInfoW));
          startupInfoW.lpDesktop := nil;
          tmpCmdLine := commandLine;
            {$IFDEF Unicode}UniqueString(tmpCmdLine);{$ENDIF Unicode}
          if DSiCreateProcessWithLogonW(PWideChar(WideString(username)),
            PWideChar(WideString(domain)), PWideChar(WideString(password)),
            1 {LOGON_WITH_PROFILE}, nil, PWideChar(WideString(tmpCmdLine)),
            CREATE_UNICODE_ENVIRONMENT, lpvEnv, PWideChar(WideString(workDirW)),
            startupInfoW, processInfo) then
            Result := 0;
        end;

        if Result = 0 then
        begin
          lastError := GetLastError;
          if wait then
          begin
            WaitForSingleObject(processInfo.hProcess, INFINITE);
            GetExitCodeProcess(processInfo.hProcess, Result);
            DSiCloseHandleAndNull(processInfo.hProcess);
            DSiCloseHandleAndNull(processInfo.hThread);
          end
          else
          begin
            Result := 0;
            if username <> '' then
            begin
              CreateProcessWatchdog(TCleanupAces.Create(processInfo.hProcess,
                interWindowStation, interDesktop, logonSID));
              interWindowStation := 0;
              interDesktop := 0;
              logonSID := nil;
            end;
          end;
          SetLastError(lastError);
        end;

      finally
        lastError := GetLastError;
        if assigned(lpvEnv) then
          DSiDestroyEnvironmentBlock(lpvEnv);
        DSiCloseHandleAndNull(logonHandle);
        DSiCloseHandleAndNull(hProcess);
        DSiFreeMemAndNil(pointer(szUserProfile));
        if origWindowStation <> 0 then
          SetProcessWindowStation(origWindowStation);
        if assigned(logonSID) and (username <> '') then
        begin
          if interWindowStation <> 0 then
            DSiRemoveAceFromWindowStation(interWindowStation, logonSID);
          if interDesktop <> 0 then
            DSiRemoveAceFromDesktop(interDesktop, logonSID);
          HeapFree(GetProcessHeap, 0, logonSID);
        end;
        if interWindowStation <> 0 then
          CloseWindowStation(interWindowStation);
        if interDesktop <> 0 then
          CloseDesktop(interDesktop);
        SetLastError(lastError);
      end;
  finally
    winErrorCode := GetLastError;
  end;
end; { DSiExecuteAsUser }

  {:Executes console process in a hidden window and captures its output in a TStrings
    object.
    Totaly reworked on 2006-01-23. New code contributed by matej.
    Handles only up to 1 MB of console process output.
    @returns ID of the console process or 0 if process couldn't be started.
    @author  aoven, Lee_Nover, gabr, matej, mitja
    @since   2003-05-24
  }
function DSiExecuteAndCapture(const app: string; output: TStrings;
  const workDir: string; var exitCode: longword; waitTimeout_sec: integer;
  onNewLine: TDSiOnNewLineCallback): cardinal;
var
  endTime_ms:  int64;
  lineBuffer:  PAnsiChar;
  lineBufferSize: integer;
  partialLine: string;
  runningTimeLeft_sec: integer;

  procedure ProcessPartialLine(buffer: PAnsiChar; numBytes: integer);
  var
    now_ms: int64;
    p: integer;
  begin
    if lineBufferSize < (numBytes + 1) then
    begin
      lineBufferSize := numBytes + 1;
      ReallocMem(lineBuffer, lineBufferSize);
    end;
    // called made sure that buffer is zero terminated
    OemToCharA(buffer, lineBuffer);
      {$IFDEF Unicode}
      partialLine := partialLine + UnicodeString(StrPas(lineBuffer));
      {$ELSE}
    partialLine := partialLine + StrPas(lineBuffer);
      {$ENDIF Unicode}
    repeat
      p := Pos(#13#10, partialLine);
      if p <= 0 then
        break; //repeat
      now_ms := DSiTimeGetTime64;
      runningTimeLeft_sec := (endTime_ms - now_ms) div 1000;
      onNewLine(Copy(partialLine, 1, p - 1), runningTimeLeft_sec);
      endTime_ms := now_ms + runningTimeLeft_sec * 1000;
      Delete(partialLine, 1, p + 1);
    until False;
  end; { ProcessPartialLine }

const
  SizeReadBuffer = 1048576;  // 1 MB Buffer

var
  appRunning: integer;
  appW: string;
  buffer: PAnsiChar;
  bytesLeftThisMsg: integer;
  bytesRead: DWORD;
  err:  cardinal;
  processInfo: TProcessInformation;
  readPipe: THandle;
  security: TSecurityAttributes;
  start: TStartUpInfo;
  totalBytesAvail: integer;
  totalBytesRead: DWORD;
  useWorkDir: string;
  writePipe: THandle;

begin { DSiExecuteAndCapture }
  Result := 0;
  err := 0;
  partialLine := '';
  lineBufferSize := 0;
  lineBuffer := nil;
  endTime_ms := DSiTimeGetTime64 + waitTimeout_sec * 1000;
  security.nLength := SizeOf(TSecurityAttributes);
  security.bInheritHandle := True;
  security.lpSecurityDescriptor := nil;
  if CreatePipe(readPipe, writePipe, @security, 0) then
  begin
    buffer := AllocMem(SizeReadBuffer + 1);
    FillChar(Start, Sizeof(Start), #0);
    start.cb := SizeOf(start);
    start.hStdOutput := writePipe;
    start.hStdInput := readPipe;
    start.hStdError := writePipe;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if workDir = '' then
      GetDir(0, useWorkDir)
    else
      useWorkDir := workDir;
    appW := app;
      {$IFDEF Unicode}UniqueString(appW);{$ENDIF Unicode}
    if CreateProcess(nil, PChar(appW), @security, @security, True,
      CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, PChar(useWorkDir),
      start, processInfo) then
    begin
      SetLastError(0);
      // [Mitja] found a situation where CreateProcess succeeded but the last error was 126
      Result := processInfo.hProcess;
      totalBytesRead := 0;
      repeat
        appRunning := WaitForSingleObject(processInfo.hProcess, 100);
        if not PeekNamedPipe(readPipe, @buffer[totalBytesRead],
          SizeReadBuffer - totalBytesRead, @bytesRead, @totalBytesAvail,
          @bytesLeftThisMsg) then
          break //repeat
        else if bytesRead > 0 then
          ReadFile(readPipe, buffer[totalBytesRead], bytesRead, bytesRead, nil);
        buffer[totalBytesRead + bytesRead] := #0; // required for ProcessPartialLine
        if assigned(onNewLine) then
          ProcessPartialLine(@buffer[totalBytesRead], bytesRead);
        totalBytesRead := totalBytesRead + bytesRead;
        if totalBytesRead = SizeReadBuffer then
          raise Exception.Create('DSiExecuteAndCapture: Buffer full!');
      until (appRunning <> WAIT_TIMEOUT) or (DSiTimeGetTime64 > endTime_ms);
      if partialLine <> '' then
      begin
        runningTimeLeft_sec := 0;
        onNewLine(partialLine, runningTimeLeft_sec);
      end;
      OemToCharA(buffer, buffer);
        {$IFDEF Unicode}
        output.Text := UnicodeString(StrPas(Buffer));
        {$ELSE}
      output.Text := StrPas(buffer);
        {$ENDIF Unicode}
    end
    else
      err := GetLastError;
    FreeMem(buffer);
    GetExitCodeProcess(processInfo.hProcess, exitCode);
    CloseHandle(processInfo.hProcess);
    CloseHandle(processInfo.hThread);
    CloseHandle(readPipe);
    CloseHandle(writePipe);
    DSiFreeMemAndNil(pointer(lineBuffer));
  end;
  if err <> 0 then
    SetLastError(err);
end; { DSiExecuteAndCapture }

  {:Retrieves affinity mask of the current process as a list of CPU IDs (0..9, A..V).
    @author  gabr
    @since   2003-11-12
  }
function DSiGetProcessAffinity: string;
begin
  Result := DSiAffinityMaskToString(DSiGetProcessAffinityMask);
end; { DSiGetProcessAffinity }

  {:Retrieves current process' affinity mask as a DWORD.
    @author  gabr
    @since   2003-11-14
  }
function DSiGetProcessAffinityMask: DWORD;
var
  processAffinityMask:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
  systemAffinityMask:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
begin
  if not DSiIsWinNT then
    Result := 1
  else
  begin
    GetProcessAffinityMask(GetCurrentProcess, processAffinityMask, systemAffinityMask);
    Result := processAffinityMask;
  end;
end; { DSiGetProcessAffinityMask }

  {:Returns memory counters for the current process.
    Requires Windows NT.
    @author  gabr
    @since   2006-12-20
  }
function DSiGetProcessMemory(var memoryCounters: TProcessMemoryCounters): boolean;
begin
  Result := DSiGetProcessMemory(GetCurrentProcess, memoryCounters);
end; { DSiGetProcessMemory }

  {:Returns memory counters for a process.
    Requires Windows NT.
    @author  gabr
    @since   2006-12-20
  }
function DSiGetProcessMemory(process: THandle;
  var memoryCounters: TProcessMemoryCounters): boolean;
begin
  FillChar(memoryCounters, SizeOf(memoryCounters), 0);
  memoryCounters.cb := SizeOf(memoryCounters);
  Result := DSiGetProcessMemoryInfo(process, @memoryCounters, memoryCounters.cb);
end; { DSiGetProcessMemory }

  {:Returns exe file name of a process.
    Requires Windows NT.
    @author  gabr
    @since   2007-11-07
  }
function DSiGetProcessFileName(process: THandle; var processName: string): boolean;
var
  Count: DWORD;
  fileName: array [0..MAX_PATH] of char;
  mainModule: HMODULE;
begin
  Result := False;
  if DSiEnumProcessModules(process, @mainModule, 1, Count) then
  begin
    Result := (DSiGetModuleFileNameEx(process, mainModule, fileName, MAX_PATH) > 0);
    if (not Result) and (GetLastError = ERROR_INVALID_HANDLE) then
      Result := (DSiGetProcessImageFileName(process, fileName, MAX_PATH) > 0);
    if Result then
      processName := string(fileName);
  end;
end; { DSiGetProcessFileName }

  {:Returns owner (user and domain) of the specified process. Requires Toolhelp API (e.g.
    non-NT4 OS).
    @author  Gre-Gor
    @since   2004-02-12
  }
function DSiGetProcessOwnerInfo(const processName: string;
  var user, domain: string): boolean;
var
  processID: DWORD;
begin
  if not DSiGetProcessID(processName, processID) then
    Result := False
  else
    Result := DSiGetProcessOwnerInfo(processID, user, domain);
end; { DSiGetProcessOwnerInfo }

procedure RetrieveSIDInfo(sid: PSID; var user, domain: string);
var
  domainSize: DWORD;
  sidUse: SID_NAME_USE;
  userSize: DWORD;
begin
  userSize := 257;
  domainSize := 257;
  SetLength(user, userSize);
  SetLength(domain, domainSize);
  if not LookupAccountSID(nil, sid, PChar(user), userSize, PChar(domain),
    domainSize, sidUse) then
    if GetLastError = ERROR_NONE_MAPPED then
      user := '?';
  user := PChar(user);
  domain := PChar(domain);
end; { RetrieveSIDInfo }

function GetOwnerName(descriptor: PSecurityDescriptor;
  var user, domain: string): boolean;
var
  defaulted: BOOL;
  sid: PSID;
begin
  Result := False;
  if not GetSecurityDescriptorOwner(descriptor, sid, defaulted) then
    Exit;
  RetrieveSIDInfo(sid, user, domain);
  Result := True;
end; { GetOwnerName }

  {:Returns owner (user and domain) of the specified process.
    @author  Gre-Gor
    @since   2004-02-12
  }
function DSiGetProcessOwnerInfo(processID: DWORD; var user, domain: string): boolean;
var
  descrSize: DWORD;
  neededSize: DWORD;
  process: THandle;
  securityDescr: PSecurityDescriptor;
  tmpResult: boolean;
begin
  Result := False;
  if not DSiEnablePrivilege('SeDebugPrivilege') then
    Exit;
  process := OpenProcess(PROCESS_ALL_ACCESS, False, processID);
  try
    descrSize  := 4096;
    neededSize := 0;
    securityDescr := AllocMem(descrSize);
    while True do
    begin
      tmpResult := GetKernelObjectSecurity(process, OWNER_SECURITY_INFORMATION,
        securityDescr, descrSize, neededSize);
      if tmpResult then
      begin
        if (neededSize > 0) and (descrSize <> neededSize) then
        begin
          descrSize := neededSize;
          ReallocMem(securityDescr, descrSize);
        end
        else
        begin
          Result := GetOwnerName(securityDescr, user, domain);
          break; //while
        end;
      end
      else if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
      begin
        ReallocMem(securityDescr, 0);
        break; //while
      end;
    end;
  finally
    CloseHandle(process);
  end;
end; { TDSiRegistry.DSiGetProcessOwnerInfo}

  {:Returns various times of the current process.
    @author  gabr
    @since   2006-12-20
  }
function DSiGetProcessTimes(var creationTime: TDateTime;
  var userTime, kernelTime: int64): boolean;
var
  exitTime: TDateTime;
begin
  Result := DSiGetProcessTimes(GetCurrentProcess, creationTime,
    exitTime, userTime, kernelTime);
end; { DSiGetProcessTimes }

  {:Returns various times of a process.
    @author  gabr
    @since   2006-12-20
  }
function DSiGetProcessTimes(process: THandle; var creationTime, exitTime: TDateTime;
  var userTime, kernelTime: int64): boolean;
var
  fsCreationTime: TFileTime;
  fsExitTime: TFileTime;
  fsKernelTime: TFileTime;
  fsUserTime: FileTime;
begin
  Result :=
    GetProcessTimes(process, fsCreationTime, fsExitTime, fsKernelTime, fsUserTime) and
    DSiFileTimeToDateTime(fsCreationTime, creationTime) and
    DSiFileTimeToDateTime(fsExitTime, exitTime);
  if Result then
  begin
    kernelTime := DSiFileTimeToMicroSeconds(fsKernelTime);
    userTime := DSiFileTimeToMicroSeconds(fsUserTime);
  end;
end; { DSiGetProcessTimes }

  {:Retrieves ID of the specified process. Requires Toolhelp API.
    @returns False if ID cannot be retrieved. Check GetLastError - if it is 0, process
             doesn't exist; otherwise it contains the Win32 error code.
    @author  gabr
    @since   2004-02-12
  }
function DSiGetProcessID(const processName: string; var processID: DWORD): boolean;
var
  hSnapshot: THandle;
  procEntry: TProcessEntry32;
begin
  Result := False;
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if hSnapshot = 0 then
    Exit;
  try
    procEntry.dwSize := Sizeof(procEntry);
    if not Process32First(hSnapshot, procEntry) then
      Exit;
    repeat
      if AnsiSameText(procEntry.szExeFile, processName) then
      begin
        processID := procEntry.th32ProcessID;
        Result := True;
        break; // repeat
      end;
    until not Process32Next(hSnapshot, procEntry);
  finally
    DSiCloseHandleAndNull(hSnapshot);
  end;
end; { DSiGetProcessID }

  {:Retrieves system affinity mask as a list of CPU IDs (0..9, A..V).
    @author  gabr
    @since   2003-11-12
  }
function DSiGetSystemAffinity: string;
begin
  Result := DSiAffinityMaskToString(DSiGetSystemAffinityMask);
end; { DSiGetSystemAffinity }

  {:Retrieves system affinity mask as a DWORD.
    @author  gabr
    @since   2003-11-14
  }
function DSiGetSystemAffinityMask: DWORD;
var
  processAffinityMask:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
  systemAffinityMask:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
begin
  if not DSiIsWinNT then
    Result := 1
  else
  begin
    GetProcessAffinityMask(GetCurrentProcess, processAffinityMask, systemAffinityMask);
    Result := systemAffinityMask;
  end;
end; { TDSiRegistry.DSiGetSystemAffinityMask }

  {:Retrieves affinity mask of the current thread as a list of CPU IDs (0..9,
    A..V).
    @author  gabr
    @since   2003-11-12
  }
function DSiGetThreadAffinity: string;
begin
  if not DSiIsWinNT then
    Result := '0'
  else
    Result := DSiAffinityMaskToString(DSiGetThreadAffinityMask);
end; { DSiGetThreadAffinity }

  {:Retrieves affinity mask of the current thread as a DWORD.
    @author  gabr
    @since   2003-11-14
  }
function DSiGetThreadAffinityMask: DWORD;
var
  processAffinityMask:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
  systemAffinityMask:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
begin
  if not DSiIsWinNT then
    Result := 1
  else
  begin
    GetProcessAffinityMask(GetCurrentProcess, processAffinityMask, systemAffinityMask);
    Result := SetThreadAffinityMask(GetCurrentThread, processAffinityMask);
    SetThreadAffinityMask(GetCurrentThread, Result);
  end;
end; { DSiGetThreadAffinityMask }

  {:Returns [kernel time] + [user time] for the current thread.
    @author  gabr
    @since   2011-09-26
  }
function DSiGetThreadTime: int64;
var
  creationTime: TDateTime;
  kernelTime: int64;
  userTime: int64;
begin
  Result := 0;
  if DSiGetThreadTimes(creationTime, userTime, kernelTime) then
    Result := userTime + kernelTime;
end; { DSiGetThreadTime }

function DSiGetThreadTime(thread: THandle): int64;
var
  creationTime: TDateTime;
  exitTime: TDateTime;
  kernelTime: int64;
  userTime: int64;
begin
  Result := 0;
  if DSiGetThreadTimes(thread, creationTime, exitTime, userTime, kernelTime) then
    Result := userTime + kernelTime;
end; { DSiGetThreadTime }

  {:Returns various times of the current thread.
    @author  gabr
    @since   2007-07-11
  }
function DSiGetThreadTimes(var creationTime: TDateTime;
  var userTime, kernelTime: int64): boolean;
var
  exitTime: TDateTime;
begin
  Result := DSiGetThreadTimes(GetCurrentThread, creationTime, exitTime,
    userTime, kernelTime);
end; { DSiGetThreadTimes }

  {:Returns various times of a thread.
    @author  gabr
    @since   2007-07-11
  }
function DSiGetThreadTimes(thread: THandle; var creationTime, exitTime: TDateTime;
  var userTime, kernelTime: int64): boolean;
var
  fsCreationTime: TFileTime;
  fsExitTime: TFileTime;
  fsKernelTime: TFileTime;
  fsUserTime: FileTime;
begin
  Result :=
    GetThreadTimes(thread, fsCreationTime, fsExitTime, fsKernelTime, fsUserTime) and
    DSiFileTimeToDateTime(fsCreationTime, creationTime) and
    DSiFileTimeToDateTime(fsExitTime, exitTime);
  if Result then
  begin
    kernelTime := DSiFileTimeToMicroSeconds(fsKernelTime);
    userTime := DSiFileTimeToMicroSeconds(fsUserTime);
  end;
end; { DSiGetThreadTimes }

 {gp}
 // Returns True if user can be impersonated. Always True on 9x architecture.
function DSiImpersonateUser(const username, password, domain: string): boolean;
var
  lastError: DWORD;
  logonHandle: THandle;
begin
  if not DSiIsWinNT then
    Result := True
  else
  begin
    Result := False;
    if DSiLogonAs(username, password, domain, logonHandle) then
    begin
      Result := DSiImpersonateLoggedOnUser(logonHandle);
      lastError := GetLastError;
      CloseHandle(logonHandle);
      SetLastError(lastError);
    end;
  end;
end; { DSiImpersonateUser }

  {:Increments working set for the current program by a specified ammount of bytes.
    @param   incMinSize Number of bytes to increment the minimum working set by (may be 0).
    @param   incMaxSize Number of bytes to increment the maximum working set by (may be 0).
    @author  gabr
    @since   2004-09-21
  }
function DSiIncrementWorkingSet(incMinSize, incMaxSize: integer): boolean;
var
  hProcess: THandle;
  maxWorkingSetSize:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
  minWorkingSetSize:
{$IF CompilerVersion >= 23}
  NativeUInt
{$ELSE}Cardinal{$IFEND}
  ;
begin
  Result := False;
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_SET_QUOTA,
    False, GetCurrentProcessId);
  try
    if not GetProcessWorkingSetSize(hProcess, minWorkingSetSize,
      maxWorkingSetSize) then
      Exit;
    Inc(minWorkingSetSize, incMinSize);
    Inc(maxWorkingSetSize, incMaxSize);
    if minWorkingSetSize > maxWorkingSetSize then
      maxWorkingSetSize := minWorkingSetSize;
    Result := SetProcessWorkingSetSize(hProcess, minWorkingSetSize, maxWorkingSetSize);
  finally
    CloseHandle(hProcess);
  end;
end; { DSiIncrementWorkingSet }

{mr}
function DSiIsDebugged: boolean;
var
  isDebuggerPresent: function: boolean; stdcall;
  kernelHandle: THandle;
  p: pointer;
begin
  kernelHandle := GetModuleHandle(kernel32);
  @isDebuggerPresent := GetProcAddress(kernelHandle, 'IsDebuggerPresent');
  if assigned(isDebuggerPresent) then // Win98+/NT4+ only
    Result := isDebuggerPresent
  else
  begin // Win9x uses thunk pointer outside the module when under a debugger
    p := GetProcAddress(kernelHandle, 'GetProcAddress');
    Result := (DWORD(p) < kernelHandle);
  end;
end; { DSiIsDebugged }

function DSiLogonAs(const username, password: string;
  var logonHandle: THandle): boolean;
  overload;
begin
  Result := DSiLogonAs(username, password, '.', logonHandle);
end; { DSiLogonAs }

  {:A simple wrapper arount the LogonUser API that handles 'domain\user' input in the
    'username' field.
    @author  gabr
    @since   2010-04-08
  }
function DSiLogonAs(const username, password, domain: string;
  var logonHandle: THandle): boolean; overload;
var
  dsiDomain: string;
  dsiUsername: string;
  posDomain: integer;
begin
  if not DSiIsWinNT then
  begin
    logonHandle := 0;
    Result := True;
  end
  else
  begin
    dsiDomain := domain;
    dsiUsername := username;
    if dsiDomain = '.' then
    begin
      posDomain := Pos('\', dsiUsername);
      if posDomain > 0 then
      begin
        dsiDomain := Copy(dsiUsername, 1, posDomain - 1);
        Delete(dsiUsername, 1, posDomain);
      end;
    end;
    Result := DSiLogonUser(PChar(dsiUsername), PChar(dsiDomain),
      PChar(password), LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT,
      logonHandle);
    if not Result then
      logonHandle := 0;
  end;
end; { DSiLogonAs }

{ln}
function DSiOpenURL(const URL: string; newBrowser: boolean): boolean;
begin
  if NewBrowser then
  begin
    ShellExecute(0, nil, PChar(DSiGetDefaultBrowser), nil, nil, SW_SHOW);
    Sleep(500); // wait a bit to load the browser
  end;
  Result := (ShellExecute(0, nil, PChar(URL), nil, nil, SW_SHOW) > 32);
end; { DSiOpenURL }

  {:Process all messages waiting in the current thread's message queue.
    @author  gabr
    @since   2003-08-25
  }
procedure DSiProcessThreadMessages;
var
  msg: TMsg;
begin
  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) and (Msg.Message <> WM_QUIT) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end; { DSiProcessThreadMessages }

{mr}
function DSiRealModuleName: string;
var
  FileName: array[0..MAX_PATH - 1] of char;
begin
  GetModuleFileName(HInstance, FileName, SizeOf(FileName));
  Result := string(FileName);
end; { DSiRealModuleName }

function DSiRemoveAceFromDesktop(desktop: HDESK; sid: PSID): boolean;
var
  aclSizeInfo: ACL_SIZE_INFORMATION;
  dacl: PACL;
  daclExists: longbool;
  daclPresent: longbool;
  iAce: integer;
  newAcl: PACL;
  newAclSize: DWORD;
  newSecDescr: PSECURITY_DESCRIPTOR;
  sdSize: DWORD;
  sdSizeNeeded: DWORD;
  secDescr: PSECURITY_DESCRIPTOR;
  secInfo: SECURITY_INFORMATION;
  tempAce: PACE_HEADER;
begin
  Result  := False;
  secDescr := nil;
  newSecDescr := nil;
  newAcl  := nil;
  secInfo := DACL_SECURITY_INFORMATION;
  sdSize  := 0;
  try
    if not GetUserObjectSecurity(desktop, secInfo, secDescr, sdSize, sdSizeNeeded) then
    begin
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
        Exit;
      secDescr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, sdSizeNeeded);
      if secDescr = nil then
        Exit;
      newSecDescr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, sdSizeNeeded);
      if newSecDescr = nil then
        Exit;
      sdSize := sdSizeNeeded;
      if not GetUserObjectSecurity(desktop, secInfo, secDescr,
        sdSize, sdSizeNeeded) then
        Exit;
    end;
    if not InitializeSecurityDescriptor(newSecDescr, SECURITY_DESCRIPTOR_REVISION) then
      Exit;
    if not GetSecurityDescriptorDacl(secDescr, daclPresent, dacl, daclExists) then
      Exit;
    ZeroMemory(@aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION));
    aclSizeInfo.AclBytesInUse := SizeOf(ACL);
    if assigned(dacl) then
      if not GetAclInformation(dacl^, @aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION),
        AclSizeInformation) then
        Exit;
    newAclSize := aclSizeInfo.AclBytesInUse + SizeOf(ACCESS_ALLOWED_ACE) +
      GetLengthSid(sid) - SizeOf(DWORD);
    newAcl := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, newAclSize);
    if (newAcl = nil) or (not InitializeAcl(newAcl^, newAclSize, ACL_REVISION)) then
      Exit;
    if daclPresent then
      for iAce := 0 to aclSizeInfo.AceCount - 1 do
      begin
        if not GetAce(dacl^, iAce, pointer(tempAce)) then
          Exit;
        if (tempAce.AceType <> ACCESS_ALLOWED_ACE_TYPE) or
          (not EqualSID(@PACCESS_ALLOWED_ACE(tempAce)^.SidStart, sid)) then
          if not AddAce(newAcl^, ACL_REVISION, MAXDWORD, tempAce, tempAce.AceSize) then
            Exit;
      end// Copy the ACEs to the new ACL.
    ;
    if not (SetSecurityDescriptorDacl(newSecDescr, True, newAcl, False) and
      SetUserObjectSecurity(desktop, secInfo, newSecDescr)) then
      Exit;
    Result := True;
  finally
    if assigned(newAcl) then
      HeapFree(GetProcessHeap, 0, newAcl);
    if assigned(secDescr) then
      HeapFree(GetProcessHeap, 0, secDescr);
    if assigned(newSecDescr) then
      HeapFree(GetProcessHeap, 0, newSecDescr);
  end;
end; { DSiRemoveAceFromDesktop }

function DSiRemoveAceFromWindowStation(station: HWINSTA; sid: PSID): boolean;
var
  ace:  ^ACCESS_ALLOWED_ACE;
  aclSizeInfo: ACL_SIZE_INFORMATION;
  dacl: PACL;
  daclExists: longbool;
  daclPresent: longbool;
  iAce: integer;
  newAcl: PACL;
  newAclSize: DWORD;
  newSecDecr: PSECURITY_DESCRIPTOR;
  reqSdSize: DWORD;
  sdSize: DWORD;
  secDescr: PSECURITY_DESCRIPTOR;
  secInfo: SECURITY_INFORMATION;
  tempAce: PACE_HEADER;
begin
  Result := False;
  secInfo := DACL_SECURITY_INFORMATION;
  ace := nil;
  secDescr := nil;
  sdSize := 0;
  newAcl := nil;
  newSecDecr := nil;
  try
    if not GetUserObjectSecurity(station, secInfo, secDescr, sdSize, reqSdSize) then
    begin
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
        Exit;
      secDescr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, reqSdSize);
      if secDescr = nil then
        Exit;
      newSecDecr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, reqSdSize);
      if newSecDecr = nil then
        Exit;
      sdSize := reqSdSize;
      if not GetUserObjectSecurity(station, secInfo, secDescr, sdSize, reqSdSize) then
        Exit;
    end;
    if not InitializeSecurityDescriptor(newSecDecr, SECURITY_DESCRIPTOR_REVISION) then
      Exit;
    if not GetSecurityDescriptorDacl(secDescr, daclPresent, dacl, daclExists) then
      Exit;
    ZeroMemory(@aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION));
    aclSizeInfo.AclBytesInUse := SizeOf(ACL);
    if dacl <> nil then
      if not GetAclInformation(dacl^, @aclSizeInfo, SizeOf(ACL_SIZE_INFORMATION),
        AclSizeInformation) then
        Exit;
    newAclSize := aclSizeInfo.AclBytesInUse + (2 * SizeOf(ACCESS_ALLOWED_ACE)) +
      (2 * GetLengthSid(sid)) - (2 * SizeOf(DWORD));
    newAcl := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, newAclSize);
    if newAcl = nil then
      Exit;
    if not InitializeAcl(newAcl^, newAclSize, ACL_REVISION) then
      Exit;
    if daclPresent then
      for iAce := 0 to aclSizeInfo.AceCount - 1 do
      begin
        if not GetAce(dacl^, iAce, pointer(tempAce)) then
          Exit;
        if (tempAce.AceType <> ACCESS_ALLOWED_ACE_TYPE) or
          (not EqualSID(@PACCESS_ALLOWED_ACE(tempAce)^.SidStart, sid)) then
          if not AddAce(newAcl^, ACL_REVISION, MAXDWORD, tempAce, tempAce.AceSize) then
            Exit;
      end;
    ace := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY,
      SizeOf(ACCESS_ALLOWED_ACE) + GetLengthSid(sid) - SizeOf(DWORD));
    if ace = nil then
      Exit;
    ace.Header.AceType := ACCESS_ALLOWED_ACE_TYPE;
    ace.Header.AceFlags := CONTAINER_INHERIT_ACE or INHERIT_ONLY_ACE or
      OBJECT_INHERIT_ACE;
    ace.Header.AceSize := SizeOf(ACCESS_ALLOWED_ACE) + GetLengthSid(sid) -
      SizeOf(DWORD);
    ace.Mask := GENERIC_ACCESS;
    if not (CopySid(GetLengthSid(sid), @ace.SidStart, sid) and
      AddAce(newAcl^, ACL_REVISION, MAXDWORD, ace, ace.Header.AceSize)) then
      Exit;
    ace.Header.AceFlags := NO_PROPAGATE_INHERIT_ACE;
    ace.Mask := WINSTA_ALL;
    if not (AddAce(newAcl^, ACL_REVISION, MAXDWORD, ace, ace.Header.AceSize) and
      SetSecurityDescriptorDacl(newSecDecr, True, newAcl, False) and
      SetUserObjectSecurity(station, secInfo, newSecDecr)) then
      Exit;
    Result := True;
  finally
    if assigned(ace) then
      HeapFree(GetProcessHeap, 0, ace);
    if assigned(newAcl) then
      HeapFree(GetProcessHeap, 0, newAcl);
    if assigned(secDescr) then
      HeapFree(GetProcessHeap, 0, secDescr);
    if assigned(newSecDecr) then
      HeapFree(GetProcessHeap, 0, newSecDecr);
  end;
end; { DSiRemoveAceFromWindowStation }

  {:Sets current process' affinity mask.
    @param   affinity List of CPUs to include in the affinity mask (0..9, A..V).
                      May contain processors not available on the system or
                      processors already excluded from the current process'
                      affinity mask.
    @returns CPUs that were actually included in the affinity mask.
    @author  gabr
    @since   2003-11-12
  }
function DSiSetProcessAffinity(affinity: string): string;
begin
  SetProcessAffinityMask(GetCurrentProcess,
    DSiValidateProcessAffinityMask(DSiStringToAffinityMask(affinity)));
  Result := DSiGetProcessAffinity;
end; { DSiSetProcessAffinity }

  {:Sets priority class for all processes with the given name. Requires Toolhelp API (e.g.
    non-NT4 OS).
    @param   priority See SetPriorityClass API function.
    @author  gabr
    @since   2004-02-12
  }
function DSiSetProcessPriorityClass(const processName: string;
  priority: DWORD): boolean;
var
  hSnapshot: THandle;
  procEntry: TProcessEntry32;
  process: THandle;
begin
  Result := False;
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if hSnapshot = 0 then
    Exit;
  try
    procEntry.dwSize := Sizeof(procEntry);
    if not Process32First(hSnapshot, procEntry) then
      Exit;
    repeat
      if AnsiSameText(procEntry.szExeFile, processName) then
      begin
        process := OpenProcess(PROCESS_SET_INFORMATION, False,
          procEntry.th32ProcessID);
        if process = 0 then
          Exit;
        try
          SetPriorityClass(process, priority);
        finally
          DSiCloseHandleAndNull(process);
        end;
      end;
    until not Process32Next(hSnapshot, procEntry);
  finally
    DSiCloseHandleAndNull(hSnapshot);
  end;
end; { TDSiRegistry.DSiSetProcessPriortyClass }

  {:Sets current thread's affinity mask.
    @param   affinity List of CPUs to include in the affinity mask (0..9, A..V).
                      May contain processors not available on the system or
                      processors already excluded from the current process' or
                      thread's affinity mask.
    @returns CPUs that were actually included in the affinity mask.
    @author  gabr
    @since   2003-11-12
  }
function DSiSetThreadAffinity(affinity: string): string;
begin
  SetThreadAffinityMask(GetCurrentThread,
    DSiValidateThreadAffinityMask(DSiStringToAffinityMask(affinity)));
  Result := DSiGetThreadAffinity;
end; { DSiSetThreadAffinity }

 {gp}
 // Reverts back to the original program 'personae'. Does nothing on the 9x architecture.
procedure DSiStopImpersonatingUser;
begin
  if DSiIsWinNT then
    DSiRevertToSelf;
end; { DSiStopImpersonatingUser }

  {:Convert affinity list (0..9, A..V) to the DWORD mask.
    @author  gabr
    @since   2003-11-14
  }
function DSiStringToAffinityMask(affinity: string): DWORD;
var
  idxID: integer;
begin
  Result := 0;
  for idxID := 32 downto 1 do
  begin
    Result := Result shl 1;
    if Pos(DSiCPUIDs[idxID], affinity) > 0 then
      Result := Result or 1;
  end; //for
end; { DSiStringToAffinityMask }

function DSiSendWMCloseToWindow(hWindow: THandle; lParam: integer): BOOL; stdcall;
var
  idWindow: DWORD;
begin
  GetWindowThreadProcessId(hWindow, @idWindow);
  if idWindow = DWORD(lParam) then
    PostMessage(hWindow, WM_CLOSE, 0, 0);
  Result := True;
end; { DSiSendWMCloseToWindow }

  {:Terminates process by ID.
    Source: http://support.microsoft.com/kb/178893
    @author  M.C, gabr
    @since   2007-12-14
  }
function DSiTerminateProcessById(processID: DWORD; closeWindowsFirst: boolean;
  maxWait_sec: integer): boolean;
var
  hProcess: THandle;
begin
  Result := False;
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, processID);
  if hProcess = 0 then
    Exit;
  try
    if closeWindowsFirst then
    begin
      EnumWindows(@DSiSendWMCloseToWindow, integer(processID));
      Result := (WaitForSingleObject(hProcess, maxWait_sec * 1000) = WAIT_OBJECT_0);
    end;
    if not Result then
      Result := TerminateProcess(hProcess, 0);
  finally
    CloseHandle(hProcess);
  end;
end; { DSiTerminateProcessById }

{mr}
procedure DSiTrimWorkingSet;
var
  hProcess: THandle;
begin
  hProcess := OpenProcess(PROCESS_SET_QUOTA, False, GetCurrentProcessId);
  try
    SetProcessWorkingSetSize(hProcess, $FFFFFFFF, $FFFFFFFF);
  finally
    CloseHandle(hProcess);
  end;
end; { DSiTrimWorkingSet }

  {:Validates process affinity mask (removes all CPUs that are not in the
    system affinity mask).
    @author  gabr
    @since   2003-11-14
  }
function DSiValidateProcessAffinity(affinity: string): string;
begin
  Result := DSiAffinityMaskToString(DSiValidateProcessAffinityMask(
    DSiStringToAffinityMask(affinity)));
end; { DSiValidateProcessAffinity }

  {:Validates process affinity mask (removes all CPUs that are not in the
    system affinity mask).
    @author  gabr
    @since   2003-11-14
  }
function DSiValidateProcessAffinityMask(affinityMask: DWORD): DWORD;
begin
  Result := DSiGetSystemAffinityMask and affinityMask;
end; { TDSiRegistry.DSiValidateProcessAffinityMask }

  {:Validates process affinity mask (removes all CPUs that are not in the
    system affinity mask).
    @author  gabr
    @since   2003-11-14
  }
function DSiValidateThreadAffinity(affinity: string): string;
begin
  Result := DSiAffinityMaskToString(DSiValidateThreadAffinityMask(
    DSiStringToAffinityMask(affinity)));
end; { DSiValidateThreadAffinityMask }

function DSiValidateThreadAffinityMask(affinityMask: DWORD): DWORD;
begin
  Result := DSiGetProcessAffinityMask and affinityMask;
end; { DSiValidateThreadAffinityMask }

procedure DSiYield;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    SwitchToThread
  else
    Sleep(1);
end; { DSiYield }

{ Memory }

{mr}
procedure DSiFreePidl(pidl: PItemIDList);
var
  allocator: IMalloc;
begin
  if Succeeded(SHGetMalloc(allocator)) then
    allocator.Free(pidl)
{$IFDEF VER90}
{$ENDIF}
  ;
end; { DSiFreePidl }

  {:Frees memory allocated with GetMem and nils the pointer to the memory.
    Does nothing if pointer is already nil.
    @author: gp
    @since   2003-05-24
  }
procedure DSiFreeMemAndNil(var mem: pointer);
var
  tmp: pointer;
begin
  if assigned(mem) then
  begin
    tmp := mem;
    mem := nil;
    FreeMem(tmp);
  end;
end; { DSiFreeMemAndNil }

  {:Wrapper for the GlobalMemoryStatusEx API. Required Windows 2000.
    @author: gp
    @since   2009-01-23
  }
function DSiGetGlobalMemoryStatus(var memoryStatus: TMemoryStatusEx): boolean;
begin
  FillChar(memoryStatus, SizeOf(memoryStatus), 0);
  memoryStatus.dwLength := SizeOf(memoryStatus);
  Result := DSiGlobalMemoryStatusEx(@memoryStatus);
end; { DSiGlobalMemoryStatusEx }

{ Windows }

const //DSiAllocateHwnd window extra data offsets
  GWL_METHODCODE = SizeOf(pointer) * 0;
  GWL_METHODDATA = SizeOf(pointer) * 1;

  //DSiAllocateHwnd hidden window (and window class) name
  CDSiHiddenWindowName = 'DSiUtilWindow';

var
  //DSiAllocateHwnd lock
  GDSiWndHandlerCritSect: TRTLCriticalSection;
  //Count of registered windows in this instance
  GDSiWndHandlerCount: integer;
  GTerminateBackgroundTasks: THandle;

  {:Class message dispatcher for the DSiUtilWindow class. Fetches instance's WndProc from
    the window extra data and calls it.
  }
function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint;
  stdcall;
var
  instanceWndProc: TMethod;
  msg: TMessage;
begin
    {$IFDEF CPUX64}
    instanceWndProc.Code := pointer(GetWindowLongPtr(Window, GWL_METHODCODE));
    instanceWndProc.Data := pointer(GetWindowLongPtr(Window, GWL_METHODDATA));
    {$ELSE}
  instanceWndProc.Code := pointer(GetWindowLong(Window, GWL_METHODCODE));
  instanceWndProc.Data := pointer(GetWindowLong(Window, GWL_METHODDATA));
    {$ENDIF ~CPUX64}
  if Assigned(TWndMethod(instanceWndProc)) then
  begin
    msg.msg := Message;
    msg.wParam := WParam;
    msg.lParam := LParam;
    msg.Result := 0;
    TWndMethod(instanceWndProc)(msg);
    Result := msg.Result;
  end
  else
    Result := DefWindowProc(Window, Message, WParam, LParam);
end; { DSiClassWndProc }

  {:Thread-safe AllocateHwnd.
    @author  gabr [based on http://fidoforum.ru/pages/new46s35o217746.ru.delphi and
                   TIcsWndHandler.AllocateHWnd from ICS v6 (http://www.overbyte.be)]
    @since   2007-05-30
  }
function DSiAllocateHWnd(wndProcMethod: TWndMethod): HWND;
var
  alreadyRegistered: boolean;
  tempClass: TWndClass;
  utilWindowClass: TWndClass;
begin
  Result := 0;
  FillChar(utilWindowClass, SizeOf(utilWindowClass), 0);
  EnterCriticalSection(GDSiWndHandlerCritSect);
  try
    alreadyRegistered := GetClassInfo(HInstance, CDSiHiddenWindowName, tempClass);
    if (not alreadyRegistered) or (tempClass.lpfnWndProc <> @DSiClassWndProc) then
    begin
      if alreadyRegistered then
          {$IFDEF ScopedUnitNames}
        Winapi.
{$ENDIF}
          Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
      utilWindowClass.lpszClassName := CDSiHiddenWindowName;
      utilWindowClass.hInstance  := HInstance;
      utilWindowClass.lpfnWndProc := @DSiClassWndProc;
      utilWindowClass.cbWndExtra := SizeOf(TMethod);
      if
{$IFDEF ScopedUnitNames}
      Winapi.
{$ENDIF}
        Windows.RegisterClass(utilWindowClass) = 0 then
        raise Exception.CreateFmt(
          'Unable to register DSiWin32 hidden window class. %s',
          [SysErrorMessage(GetLastError)]);
    end;
    Result := CreateWindowEx(WS_EX_TOOLWINDOW, CDSiHiddenWindowName,
      '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
    if Result = 0 then
      raise Exception.CreateFmt('Unable to create DSiWin32 hidden window. %s',
        [SysErrorMessage(GetLastError)]);
      {$IFDEF CPUX64}
      SetWindowLongPtr(Result, GWL_METHODDATA, NativeInt(TMethod(wndProcMethod).Data));
      SetWindowLongPtr(Result, GWL_METHODCODE, NativeInt(TMethod(wndProcMethod).Code));
      {$ELSE}
    SetWindowLong(Result, GWL_METHODDATA, cardinal(TMethod(wndProcMethod).Data));
    SetWindowLong(Result, GWL_METHODCODE, cardinal(TMethod(wndProcMethod).Code));
      {$ENDIF ~CPUX64}
    Inc(GDSiWndHandlerCount);
  finally
    LeaveCriticalSection(GDSiWndHandlerCritSect);
  end;
end; { DSiAllocateHWnd }

  {:Thread-safe DeallocateHwnd.
    @author  gabr [based on http://fidoforum.ru/pages/new46s35o217746.ru.delphi and
                   TIcsWndHandler.AllocateHWnd from ICS v6 (http://www.overbyte.be)]
    @since   2007-05-30
  }
procedure DSiDeallocateHWnd(wnd: HWND);
begin
  if wnd = 0 then
    Exit;
  DestroyWindow(wnd);
  EnterCriticalSection(GDSiWndHandlerCritSect);
  try
    Dec(GDSiWndHandlerCount);
    if GDSiWndHandlerCount <= 0 then
        {$IFDEF ScopedUnitNames}
      Winapi.
{$ENDIF}
        Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
  finally
    LeaveCriticalSection(GDSiWndHandlerCritSect);
  end;
end; { DSiDeallocateHWnd }

  {:Uses PowerCfg to disable standby and hibernation.
  }
function DSiDisableStandby: boolean;

  function ExtractSchemeNumber(queryOut: TStringList; var schemeNum: integer): boolean;
  var
    ln: string;
    pNum: integer;
  begin
    //c:\> powercfg /query

    //Field Description          Value
    //-----------------          -----
    //Name                       Home/Office Desk
    //Numerical ID               0
    //...
    Result := False;
    while (queryOut.Count > 0) and (Copy(queryOut[0], 1, 1) <> '-') do
      queryOut.Delete(0);
    if queryOut.Count >= 2 then
    begin
      ln := queryOut[2];
      pNum := Length(ln);
      while (pNum > 0) and (ln[pNum] >= '0') and (ln[pNum] <= '9') do
        Dec(pNum);
      Inc(pNum);
      Result := TryStrToInt(Copy(ln, pNum, Length(ln)), schemeNum);
    end;
  end; { ExtractSchemeNumber }

var
  execExit: cardinal;
  execOut: TStringList;
  execRes: cardinal;
  schemeNum: integer;
  winVer: TDSiWindowsVersion;
begin
  Result := False;
  SetLastError(ERROR_NOT_SUPPORTED);
  execOut := TStringList.Create;
  try
    winVer := DSiGetTrueWindowsVersion;
    if winVer >= wvWinXP then
      if winVer < wvWinVista then
      begin
        execRes := DSiExecuteAndCapture('powercfg.exe /query', execOut, '', execExit);
        if (execRes = 0) or (not ExtractSchemeNumber(execOut, schemeNum)) then
          Exit;
        Result := (0 = DSiExecute('powercfg.exe /numerical /change ' +
          IntToStr(schemeNum) + ' /standby-timeout-ac 0 /standby-timeout-dc 0' +
          ' /hibernate-timeout-ac 0 /hibernate-timeout-dc 0',
          SW_HIDE, '', True));
        if Result then
          Result := (0 = DSiExecute('powercfg /hibernate off', SW_HIDE, '', True));
      end
      else
      begin
        Result := (0 = DSiExecute('powercfg.exe -change -standby-timeout-ac 0',
          SW_HIDE, '', True));
        if Result then
          Result := (0 = DSiExecute('powercfg.exe -change -standby-timeout-dc 0',
            SW_HIDE, '', True));
        if Result then
          Result := (0 = DSiExecute('powercfg.exe -change -hibernate-timeout-ac 0',
            SW_HIDE, '', True));
        if Result then
          Result := (0 = DSiExecute('powercfg.exe -change -hibernate-timeout-dc 0',
            SW_HIDE, '', True));
        if Result then // -hibernate will fail when run without admin privileges
          DSiExecute('powercfg -hibernate off', SW_HIDE, '', True);
      end;
  finally
    execOut.Free;
  end;
end; { DSiDisableStandby }

  {:Disables 'X' button and Alt+F4.
    @author  aoven
    @since   2003-09-02
  }
procedure DSiDisableX(hwnd: THandle);
begin
  EnableMenuItem(GetSystemMenu(hwnd, False), SC_CLOSE, MF_BYCOMMAND or MF_DISABLED);
end; { DSiDisableX }

  {:Enables 'X' button and Alt+F4.
    @author  gabr
    @since   2003-09-02
  }
procedure DSiEnableX(hwnd: THandle);
begin
  EnableMenuItem(GetSystemMenu(hwnd, False), SC_CLOSE, MF_BYCOMMAND or MF_ENABLED);
end; { DSiEnableX }

const
  EWX_LOGOFF_FORCE = $00;
  EWX_POWEROFF_FORCE = $0A;
  EWX_REBOOT_FORCE = $06;
  EWX_SHUTDOWN_FORCE = $05;

  CExitWindows: array [TDSiExitWindows] of integer = (EWX_LOGOFF, EWX_LOGOFF_FORCE,
    EWX_POWEROFF, EWX_POWEROFF_FORCE, EWX_REBOOT, EWX_REBOOT_FORCE, EWX_SHUTDOWN,
    EWX_SHUTDOWN_FORCE);

  {:Exits (logoff, shutdown, restart) the Windows.
    @author  xtreme
    @since   2005-02-13
  }
function DSiExitWindows(exitType: TDSiExitWindows): boolean;
begin
  Result := False;
  if DSiEnablePrivilege('SeShutdownPrivilege') then
    Result := ExitWindowsEx(CExitWindows[exitType], 0);
end; { DSiExitWindows }

{gp}
function DSiForceForegroundWindow(hwnd: THandle; restoreFirst: boolean): boolean;
var
  ForegroundThreadID: DWORD;
  ThisThreadID: DWORD;
  timeout: DWORD;
begin
  if restoreFirst then
    if IsIconic(hwnd) then
      ShowWindow(hwnd, SW_RESTORE);

  if GetForegroundWindow = hwnd then
    Result := True
  else
  begin

    // Windows 98/2000 doesn't want to foreground a window when some other
    // window has keyboard focus

    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
      ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
      (Win32MinorVersion > 0)))) then
    begin

      // Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
      // Converted to Delphi by Ray Lischner
      // Published in The Delphi Magazine 55, page 16

      Result := False;
      ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil);
      ThisThreadID := GetWindowThreadPRocessId(hwnd, nil);
      if AttachThreadInput(ThisThreadID, ForegroundThreadID, True) then
      begin
        BringWindowToTop(hwnd); //IE 5.5 - related hack
        SetForegroundWindow(hwnd);
        AttachThreadInput(ThisThreadID, ForegroundThreadID, False);
        Result := (GetForegroundWindow = hwnd);
      end;
      if not Result then
      begin

        // Code by Daniel P. Stasinski <dannys@karemor.com>

        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),
          SPIF_SENDCHANGE);
        BringWindowToTop(hwnd); //IE 5.5 - related hack
        SetForegroundWindow(hWnd);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,
          TObject(timeout), SPIF_SENDCHANGE);
      end;
    end
    else
    begin
      BringWindowToTop(hwnd); //IE 5.5 - related hack
      SetForegroundWindow(hwnd);
    end;

    Result := (GetForegroundWindow = hwnd);
  end;
end; { DSiForceForegroundWindow }

{gp}
function DSiGetClassName(hwnd: THandle): string;
var
  winClass: array [0..1024] of char;
begin
  if GetClassName(hwnd, winClass, SizeOf(winClass)) <> 0 then
    Result := winClass
  else
    Result := '';
end; { DSiGetClassName }

type
  TProcWndInfo = record
    TargetProcessID: DWORD;
    FoundWindow: HWND;
  end; { TProcWndInfo }
  PProcWndInfo = ^TProcWndInfo;

function EnumGetProcessWindow(wnd: HWND; userParam: LPARAM): BOOL; stdcall;
var
  wndProcessID: DWORD;
begin
  GetWindowThreadProcessId(wnd, @wndProcessID);
  if (wndProcessID = PProcWndInfo(userParam)^.TargetProcessID) and
    (GetWindowLong(wnd, GWL_HWNDPARENT) = 0) then
  begin
    PProcWndInfo(userParam)^.FoundWindow := Wnd;
    Result := False;
  end
  else
    Result := True;
end; { EnumGetProcessWindow }

{ln}
function DSiGetProcessWindow(targetProcessID: cardinal): HWND;
var
  procWndInfo: TProcWndInfo;
begin
  procWndInfo.TargetProcessID := targetProcessID;
  procWndInfo.FoundWindow := 0;
  EnumWindows(@EnumGetProcessWindow, LPARAM(@procWndInfo));
  Result := procWndInfo.FoundWindow;
end; { DSiGetProcessWindow }

{gp}
function DSiGetWindowText(hwnd: THandle): string;
var
  winText: array [0..1024] of char;
begin
  if GetWindowText(hwnd, winText, SizeOf(winText)) <> 0 then
    Result := winText
  else
    Result := '';
end; { DSiGetWindowTextStr }

  {:Processes all waiting window messages.
    @author  gabr
    @since   2003-08-18
  }
procedure DSiProcessMessages(hwnd: THandle; waitForWMQuit: boolean);
var
  bGet: longint;
  msg:  TMsg;
begin
  if hwnd = 0 then
    Exit;
  repeat
    if not waitForWMQuit then
    begin
      if not PeekMessage(msg, hwnd, 0, 0, PM_REMOVE) then
        break; //repeat
    end
    else
    begin
      bGet := longint(GetMessage(msg, hwnd, 0, 0));
      if (bGet = 0) or (bGet = -1) then
        break; //repeat
    end;
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  until msg.Message = WM_QUIT;
end; { DSiProcessMessages }

{xtreme}
procedure DSiRebuildDesktopIcons;
var
  dwResult: cardinal;
  oldSize:  integer;
  registry: TRegistry;
const
  CShellIconSize = 'Shell Icon Size';
  CTimeout = 10000;
begin
  registry := TRegistry.Create;
  try
    if not registry.OpenKey('Control Panel\Desktop\WindowMetrics', False) then
      Exit;
    if registry.ValueExists(CShellIconSize) then
      oldSize := StrToInt(registry.ReadString(CShellIconSize))
    else
      oldSize := 0;
    registry.WriteString(CShellIconSize, IntToStr(oldSize + 1));
    SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
      SPI_SETNONCLIENTMETRICS, 0, SMTO_ABORTIFHUNG, CTimeout,
        {$IF CompilerVersion >= 23}
      @
{$IFEND}
      dwResult);
    if oldSize > 0 then
      registry.WriteString(CShellIconSize, IntToStr(oldSize))
    else
      registry.DeleteValue(CShellIconSize);
    SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
      SPI_SETNONCLIENTMETRICS, 0, SMTO_ABORTIFHUNG, CTimeout,
        {$IF CompilerVersion >= 23}
      @
{$IFEND}
      dwResult);
    registry.CloseKey;
  finally
    FreeAndNil(registry);
  end;
end; { DSiRebuildDesktopIcons }

{xtreme}
procedure DSiRefreshDesktop;
var
  handleDesktop: HWND;
begin
  handleDesktop := FindWindowEx(FindWindowEx(FindWindow('Progman', 'Program Manager'),
    0, 'SHELLDLL_DefView', ''), 0, 'SysListView32', '');
  PostMessage(handleDesktop, WM_DDE_FIRST, VK_F5, 0);
  PostMessage(handleDesktop, WM_DDE_LAST, VK_F5, 1 shl 31);
end; { DSiRefreshDesktop }

{ln}
procedure DSiSetTopMost(hwnd: THandle; onTop, activate: boolean);
const
  cTopMost: array [boolean] of THandle = (HWND_NOTOPMOST, HWND_TOPMOST);
  cActivate: array [boolean] of UINT = (SWP_NOACTIVATE, 0);
begin
  SetWindowPos(hwnd, cTopMost[OnTop], 0, 0, 0, 0,
    SWP_NOMOVE or SWP_NOSIZE or cActivate[Activate]);
end; { DSiSetTopMost }

{ Aero }

 ///<summary>Disables Aero interface on Vista. Does nothing on older platforms.</summary>
 ///<returns>True if Aero was disabled or if Aero is not supported.</returns>
 ///<author>gabr</author>
 ///<remarks>Based on code by David J Taylor published in
 ///    news://borland.public.delphi.language.delphi.win32.</remarks>
 ///<since>2007-10-25</since>
function DSiAeroDisable: boolean;
begin
  Result := (DSiDwmEnableComposition(DWM_EC_DISABLECOMPOSITION) = S_OK);
  if not assigned(GDwmEnableComposition) then
    Result := True;
end; { DSiAeroDisable }

 ///<summary>Enables Aero interface on Vista. Does nothing on older platforms.</summary>
 ///<returns>True if Aero was enabled. False if Aero is not supported.</returns>
 ///<author>gabr</author>
 ///<remarks>Based on code by David J Taylor published in
 ///    news://borland.public.delphi.language.delphi.win32.</remarks>
 ///<since>2007-10-25</since>
function DSiAeroEnable: boolean;
begin
  Result := (DSiDwmEnableComposition(DWM_EC_ENABLECOMPOSITION) = S_OK);
end; { DSiAeroEnable }

///<summary>Checks if Aero interface is enabled.</summary>
///<returns>True if Aero is enabled. False if Aero is disabled or not supported.</returns>
 ///<author>gabr</author>
 ///<since>2007-10-25</since>
function DSiAeroIsEnabled: boolean;
var
  isEnabled: BOOL;
begin
  Result := (DSiDwmIsCompositionEnabled(isEnabled) = S_OK);
  if Result then
    Result := isEnabled;
end; { DSiAeroIsEnabled }

{ Taskbar }

{ln}
function DSiGetTaskBarPosition: integer;
var
  pData: TAppBarData;
begin
  Result := -1;
  pData.cbSize := SizeOf(TAppBarData);
  pData.hWnd := 0;
  if SHAppBarMessage(ABM_GETTASKBARPOS, pData) = 0 then
    Exit;
  Result := pData.uEdge;
end; { DSiGetTaskBarPosition }

{ Menus }

{gp}
function DSiGetHotkey(const item: string): char;
var
  item2: string;
  p: integer;
begin
  item2 := StringReplace(item, '&&', '&', [rfReplaceAll]);
  p := Pos('&', item2);
  if (p > 0) and (p < Length(item2)) then
    Result := UpCase(item2[p + 1])
  else
    Result := #0;
end; { DSiGetHotkey }

{gp}
function DSiGetMenuItem(menu: HMENU; item: integer): string;
var
  res: integer;
  buf: array [0..1024] of char;
begin
  res := GetMenuString(menu, item, buf, SizeOf(buf), MF_BYPOSITION);
  if res > 0 then
    Result := buf
  else
    Result := '';
end; { DSiGetMenuItem }

{ Screen }

{mr}
procedure DSiDisableScreenSaver(out currentlyActive: boolean);
var
  isActive: BOOL;
begin
  SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @isActive, 0);
  currentlyActive := isActive;
  if currentlyActive then
    SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, UINT(False), nil,
      SPIF_SENDWININICHANGE);
end; { DSiDisableScreenSaver }

{mr}
procedure DSiEnableScreenSaver;
begin
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, UINT(True), nil,
    SPIF_SENDWININICHANGE);
end; { DSiEnableScreenSaver }

{mr}
function DSiGetBitsPerPixel: integer;
var
  h: hDC;
begin
  h := GetDC(0);
  try
    Result := GetDeviceCaps(h, BITSPIXEL);
  finally
    ReleaseDC(0, h);
  end;
end; { DSiGetBitsPerPixel }

{mr}
function DSiGetBPP: integer;
var
  DC: HDC;
begin
  DC := GetDC(0);
  try
    Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
  finally
    ReleaseDC(0, DC);
  end;
end; { DSiGetBPP }

{mr}
function DSiGetDesktopSize: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
end; { DSiGetDesktopSize }

{ln}
function DSiIsFullScreen: boolean;
var
  desktopRect: TRect;
  foregroundRect: TRect;
begin
  Result :=
    GetWindowRect(GetForegroundWindow, foregroundRect) and
    GetWindowRect(GetDesktopWindow, desktopRect) and
    (not PtInRect(desktopRect, foregroundRect.TopLeft)) and
    (not PtInRect(desktopRect, foregroundRect.BottomRight));
end; { DSiIsFullScreen }

{ales}
procedure DSiMonitorOff;
begin
  SendMessage(GetForegroundWindow, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
end; { DSiMonitorOff }

{ales}
procedure DSiMonitorOn;
begin
  SendMessage(GetForegroundWindow, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
end; { DSiMonitorOn }

{gp}
procedure DSiMonitorStandby;
begin
  SendMessage(GetForegroundWindow, WM_SYSCOMMAND, SC_MONITORPOWER, 1);
end; { DSiMonitorOff }

{matijap}
function DSiSetScreenResolution(Width, Height: integer): longint;
var
  deviceMode: TDeviceMode;
begin
  with deviceMode do
  begin
    dmSize := SizeOf(TDeviceMode);
    dmPelsWidth := Width;
    dmPelsHeight := Height;
    dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  end;
  Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end; { DSiSetScreenResolution }

{ Rectangles }

  {:Centers rectangle over another rectangle.
    @since   2007-12-29
    @author  gabr
  }
procedure DSiCenterRectInRect(const ownerRect: TRect; var clientRect: TRect);
var
  clientCenter: TPoint;
  ownerCenter:  TPoint;
begin
  ownerCenter  := CenterPoint(ownerRect);
  clientCenter := CenterPoint(clientRect);
  OffsetRect(clientRect, ownerCenter.X - clientCenter.X, ownerCenter.Y -
    clientCenter.Y);
end; { DSiCenterRectInRect }

  {:Makes sure rectangle is fully placed inside another rectangle.
    @since   2007-12-29
    @author  gabr
  }
procedure DSiMakeRectFullyVisibleOnRect(const ownerRect: TRect; var clientRect: TRect);
begin
  if clientRect.Left < ownerRect.Left then
    OffsetRect(clientRect, ownerRect.Left - clientRect.Left, 0)
  else if clientRect.Right > ownerRect.Right then
    OffsetRect(clientRect, ownerRect.Right - clientRect.Right, 0);
  if clientRect.Top < ownerRect.Top then
    OffsetRect(clientRect, 0, ownerRect.Top - clientRect.Top)
  else if clientRect.Bottom > ownerRect.Bottom then
    OffsetRect(clientRect, 0, ownerRect.Bottom - clientRect.Bottom);
end; { DSiMakeRectFullyVisibleOnRect }

{ Clipboard }

var
  GCF_HTML: UINT;

  {:Checks if HTML format is stored on the clipboard.
    @since   2008-04-29
    @author  gabr
  }
function DSiIsHtmlFormatOnClipboard: boolean;
begin
  Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }

  {:Retrieves HTML format from the clipboard. If there is no HTML format on the clipboard,
    function returns empty string.
    @since   2008-04-29
    @author  MP002, gabr
  }
function DSiGetHtmlFormatFromClipboard: string;
var
  hClipData: THandle;
  idxEndFragment: integer;
  idxStartFragment: integer;
  pClipData: PChar;
begin
  Result := '';
  if DSiIsHtmlFormatOnClipboard then
  begin
    Win32Check(OpenClipboard(0));
    try
      hClipData := GetClipboardData(GCF_HTML);
      if hClipData <> 0 then
      begin
        pClipData := GlobalLock(hClipData);
        Win32Check(assigned(pClipData));
        try
          idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
          idxEndFragment := Pos('<!--EndFragment-->', pClipData);
          if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
            Result := Copy(pClipData, idxStartFragment + 20,
              idxEndFragment - idxStartFragment - 20);
        finally
          GlobalUnlock(hClipData);
        end;
      end;
    finally
      Win32Check(CloseClipboard);
    end;
  end;
end; { DSiGetHtmlFormatFromClipboard }

  {:Copies HTML (and, optionally, text) format to the clipboard.
    @since   2008-04-29
    @author  MP002, gabr
  }
procedure DSiCopyHtmlFormatToClipboard(const sHtml, sText: string);

  function MakeFragment(const sHtml: string): string;
  const
    CVersion = 'Version:1.0'#13#10;
    CStartHTML = 'StartHTML:';
    CEndHTML = 'EndHTML:';
    CStartFragment = 'StartFragment:';
    CEndFragment = 'EndFragment:';
    CHTMLIntro =
      '<sHtml><head><title>HTML clipboard</title></head><body><!--StartFragment-->';
    CHTMLExtro = '<!--EndFragment--></body></sHtml>';
    CNumberLengthAndCR = 10;
    CDescriptionLength = // Let the compiler determine the description length.
      Length(CVersion) + Length(CStartHTML) + Length(CEndHTML) +
      Length(CStartFragment) + Length(CEndFragment) + 4 * CNumberLengthAndCR;
  var
    description: string;
    idxEndFragment: integer;
    idxEndHtml:  integer;
    idxStartFragment: integer;
    idxStartHtml: integer;
  begin
    // The sHtml clipboard format is defined by using byte positions in the entire block
    // where sHtml text and fragments start and end. These positions are written in a
    // description. Unfortunately the positions depend on the length of the description
    // but the description may change with varying positions. To solve this dilemma the
    // offsets are converted into fixed length strings which makes it possible to know
    // the description length in advance.
    idxStartHtml := CDescriptionLength;
    // position 0 after the description
    idxStartFragment := idxStartHtml + Length(CHTMLIntro);
    idxEndFragment := idxStartFragment + Length(sHtml);
    idxEndHtml := idxEndFragment + Length(CHTMLExtro);
    description := CVersion +
        {$IFDEF ScopedUnitNames}
      System.
{$ENDIF}
      SysUtils.Format('%s%.8d', [CStartHTML, idxStartHtml]) + #13#10 +
        {$IFDEF ScopedUnitNames}
      System.
{$ENDIF}
      SysUtils.Format('%s%.8d', [CEndHTML, idxEndHtml]) + #13#10 +
        {$IFDEF ScopedUnitNames}
      System.
{$ENDIF}
      SysUtils.Format('%s%.8d', [CStartFragment, idxStartFragment]) + #13#10 +
        {$IFDEF ScopedUnitNames}
      System.
{$ENDIF}
      SysUtils.Format('%s%.8d', [CEndFragment, idxEndFragment]) + #13#10;
    Result := description + CHTMLIntro + sHtml + CHTMLExtro;
  end; { MakeFragment }

var
  clipFormats: array[0..1] of UINT;
  clipStrings: array[0..1] of string;
  hClipData: HGLOBAL;
  iFormats:  integer;
  pClipData: PChar;

begin { DSiCopyHtmlFormatToClipboard }
  Win32Check(OpenClipBoard(0));
  try
    //most descriptive first as per api docs
    clipStrings[0] := MakeFragment(sHtml);
    if sText = '' then
      clipStrings[1] := sHtml
    else
      clipStrings[1] := sText;
    clipFormats[0] := GCF_HTML;
    clipFormats[1] := CF_TEXT;
    Win32Check(EmptyClipBoard);
    for iFormats := 0 to High(clipStrings) do
    begin
      if clipStrings[iFormats] = '' then
        continue;
      hClipData := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE,
        Length(clipStrings[iFormats]) + 1);
      Win32Check(hClipData <> 0);
      try
        pClipData := GlobalLock(hClipData);
        Win32Check(assigned(pClipData));
        try
          Move(PChar(clipStrings[iFormats])^, pClipData^,
            Length(clipStrings[iFormats]) + 1);
        finally
          GlobalUnlock(hClipData);
        end;
        Win32Check(SetClipboardData(clipFormats[iFormats], hClipData) <> 0);
        hClipData := 0;
      finally
        if hClipData <> 0 then
          GlobalFree(hClipData);
      end;
    end;
  finally
    Win32Check(CloseClipboard);
  end;
end; { DSiCopyHtmlFormatToClipboard }

{ Information }

  {:Retrieves application compatibility flags. Works around WOW64 problems.
    @since   2007-02-11
    @author  Miha-R, gabr
  }
function DSiGetAppCompatFlags(const exeName: string): string;
var
  wow64key: longword;
begin
  Result := DSiReadRegistry(
    'Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers',
    exeName, '', HKEY_CURRENT_USER);
  if DSiIsWow64 then
    wow64key := KEY_WOW64_64KEY
  else
    wow64key := 0;
  Result := Result + ' ' + DSiReadRegistry(
    'Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers',
    exeName, '', HKEY_LOCAL_MACHINE, KEY_QUERY_VALUE or wow64key);
  Result := Trim(Result);
end; { DSiGetAppCompatFlags }

  {:Returns type of a last boot.
    @author  ales, gabr
    @since   2003-09-02
  }
function DSiGetBootType: TDSiBootType;
var
  iBoot: integer;
begin
  iBoot := GetSystemMetrics(SM_CLEANBOOT);
  if iBoot = 0 then
    Result := btNormal
  else if iBoot = 1 then
    Result := btFailSafe
  else if iBoot = 2 then
    Result := btFailSafeWithNetwork
  else
    Result := btUnknown;
end; { DSiGetBootType }

  {:Returns name of the licensee organisation.
    @author  Lee_Nover
    @since   2002-11-25
  }
function DSiGetCompanyName: string;
begin
  Result := DSiReadRegistry(DSiWinVerKeys[DSiIsWinNT], 'RegisteredOrganization',
    '', HKEY_LOCAL_MACHINE);
end; { DSiGetCompanyName }

  {:Returns computer name.
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetComputerName: string;
var
  buffer: PChar;
  bufferSize: DWORD;
begin
  bufferSize := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(buffer, bufferSize * SizeOf(char));
  try
    GetComputerName(buffer, bufferSize);
    SetLength(Result, StrLen(buffer));
    if Result <> '' then
      Move(buffer^, Result[1], Length(Result) * SizeOf(char));
  finally
    FreeMem(buffer);
  end;
end; { DSiGetComputerName }

  {:Returns path to default web browser.
    @author  Lee_Nover
    @since   2002-11-25
  }
function DSiGetDefaultBrowser: string;
begin
  Result := DSiReadRegistry('http\shell\open\command', '', '', HKEY_CLASSES_ROOT);
end; { DSiGetDefaultBrowser }

  {:Returns DirectX version.
    @author  Lee_Nover
    @since   2002-11-25
  }
function DSiGetDirectXVer: string;
begin
  Result := DSiReadRegistry('\Software\Microsoft\DirectX', 'Version',
    '', HKEY_LOCAL_MACHINE);
end; { DSiGetDirectXVer }

  {:Returns name of the operating system licensee.
    @author  Lee_Nover
    @since   2002-11-25
  }
function DSiGetRegisteredOwner: string;
begin
  Result := DSiReadRegistry(DSiWinVerKeys[DSiIsWinNT], 'RegisteredOwner',
    '', HKEY_LOCAL_MACHINE);
end; { DSiGetRegisteredOwner }

  {:Returns disk label of the specified drive.
    @author  Odisej
    @since   2003-10-09
  }
function DSiGetDiskLabel(disk: char): string;
var
  fileSysFlags: DWORD;
  maxCompLen: DWORD;
  volName: array [0..MAX_PATH] of char;
begin
  if GetVolumeInformation(PChar(disk + ':\'), volName, SizeOf(volName) - 1,
    nil, maxCompLen, fileSysFlags, nil, 0) then
    Result := volName
  else
    Result := '';
end; { DSiGetDiskLabel }

  {:Returns serial number of the specified drive.
    @author  ales
    @since   2002-11-25
  }
function DSiGetDiskSerial(disk: char): string;
var
  fileSysFlags: DWORD;
  maxCompLen: DWORD;
  serNum: DWORD;
begin
  GetVolumeInformation(PChar(disk + ':\'), nil, 0, @serNum,
    maxCompLen, fileSysFlags, nil, 0);
  Result := Format('%.4x-%.4x', [HiWord(serNum), LoWord(serNum)]);
end; { DSiGetDiskSerial }

  {:Helper function returning current domain on an NT system.
    @author  Lee_Nover
    @since   2003-09-02
  }
function GetDomainNT: string;
var
  pwi: PWkstaInfo100;
begin
  if DSiNetWkstaGetInfo(nil, 100, pointer(pwi)) = 0 then
    Result := string(pwi.wki100_langroup)
  else
    Result := '';
end; { GetDomainNT }

  {:Returns the domain system is logged onto.
    @author  Lee_Nover
    @since   2003-09-02
  }
function DSiGetDomain: string;
begin
  if DSiIsWinNT then
    Result := GetDomainNT
  else
  begin
    Result := DSiReadRegistry(
      '\System\CurrentControlSet\Services\MSNP32\NetworkProvider',
      'AuthenticatingAgent', '', HKEY_LOCAL_MACHINE);
    if Result = '' then // 9x
      Result := DSiReadRegistry('\System\CurrentControlSet\Services\VXD\VNETSUP',
        'Workgroup', '', HKEY_LOCAL_MACHINE);
  end;
end; { DSiGetDomain }

  {:Returns value of an environment variable.
    @author  gabr
    @since   2005-06-06
  }
function DSiGetEnvironmentVariable(const envVarName: string): string;
var
  bufSize: integer;
begin
  Result  := '';
  bufSize := GetEnvironmentVariable(PChar(envVarName), nil, 0);
  if bufSize <> 0 then
  begin
    SetLength(Result, bufSize - 1);
    if GetEnvironmentVariable(PChar(envVarName), PChar(Result), bufSize) = 0 then
      Result := '';
  end;
end; { DSiGetEnvironmentVariable }

  {:Returns location of a special folder.
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetFolderLocation(const CSIDL: integer): string;
var
  path:  PChar;
  pPIDL: PItemIDList;
begin
  GetMem(path, MAX_PATH * SizeOf(char));
  try
    if Succeeded(SHGetSpecialFolderLocation(0, CSIDL, pPIDL)) then
    begin
      SHGetPathFromIDList(pPIDL, path);
      DSiFreePidl(pPIDL);
    end
    else
      StrCopy(path, '');
    Result := string(path);
  finally
    FreeMem(path);
  end;
end; { DSiGetFolderLocation }

  {:Returns list of available keyboard layouts. Objects[] property contains pointer to
    locale data, returned by the GetLocaleInfo. 
    @since   2005-02-13
  }
procedure DSiGetKeyboardLayouts(layouts: TStrings);
var
  iLayout: integer;
  keyLayList: array [0..9] of HKL;
  keyLayouts: array [0..255] of char;
begin
  layouts.Clear;
  for iLayout := 0 to GetKeyboardLayoutList(SizeOf(keyLayList), keyLayList) - 1 do
  begin
    GetLocaleInfo(LoWord(keyLayList[iLayout]), LOCALE_SLANGUAGE, keyLayouts,
      SizeOf(keyLayouts));
    layouts.AddObject(keyLayouts, pointer(keyLayList[iLayout]));
  end;
end; { DSiGetKeyboardLayouts }

  {:Returns My Documents folder.
    @author  xtreme
    @since   2003-10-09
  }
function DSiGetMyDocumentsFolder: string;
begin
  Result := DSiReadRegistry(
    '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
    'Personal', '');
end; { DSiGetMyDocumentsFolder }

  {:Returns program files folder (i.e. C:\Program Files or similar).
    @author  gabr
    @since   2002-11-25
  }
function DSiGetProgramFilesFolder: string;
begin
  Result := DSiReadRegistry('\Software\Microsoft\Windows\CurrentVersion',
    'ProgramFilesDir', '', HKEY_LOCAL_MACHINE);
end; { DSiGetProgramFilesFolder }

  {:Returns system folder (i.e. C:\Windows\System32 or similar).
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetSystemFolder: string;
var
  path: array [1..MAX_PATH] of char;
begin
  if GetSystemDirectory(@path, MAX_PATH) <> 0 then
    Result := StrPas(PChar(@path))
  else
    Result := '';
end; { DSiGetSystemDirectory }

  {:Returns system default language formatted as a string.
    @author  xtreme
    @since   2005-02-13
  }
function DSiGetSystemLanguage: string;
var
  lngID: LANGID;
  lngName: array [0..127] of char;
begin
  lngID := GetSystemDefaultLangID;
  VerLanguageName(lngID, lngName, 127);
  Result := lngName;
end; { DSiGetSystemLanguage }

  {:Returns extended information on operating system version (service pack level etc).
    @author  xtreme
    @since   2003-10-09
  }
function DSiGetSystemVersion: string;
var
  versionInfo: TOSVersionInfo;
begin
  try
    versionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
    GetVersionEx(versionInfo);
  finally
    Result := versionInfo.szCSDVersion;
  end;
end; { DSiGetSystemVersion }

  {:Tries to return a true OS version when application has compatibility flags set.
    @since   2007-02-11
    @author  Miha-R, gabr
  }
function DSiGetTrueWindowsVersion: TDSiWindowsVersion;

  function ExportsAPI(module: HMODULE; const apiName: string): boolean;
  begin
    Result := GetProcAddress(module, PChar(apiName)) <> nil;
  end; { ExportsAPI }

var
  hKernel32: HMODULE;

begin { DSiGetTrueWindowsVersion }
  hKernel32 := GetModuleHandle('kernel32');
  Win32Check(hKernel32 <> 0);
  if ExportsAPI(hKernel32, 'CreateRemoteThreadEx') then
    Result := wvWin7OrServer2008R2
  else if ExportsAPI(hKernel32, 'AddSecureMemoryCacheCallback') then
    Result := wvWinServer2008OrVistaSP1
  else if ExportsAPI(hKernel32, 'GetLocaleInfoEx') then
    Result := wvWinVista
  else if ExportsAPI(hKernel32, 'GetLargePageMinimum') then
    Result := wvWinServer2003
  //    else if ExportsAPI(hKernel32, 'GetDLLDirectory') then
  //      Result := wvWinXPSP1
  else if ExportsAPI(hKernel32, 'GetNativeSystemInfo') then
    Result := wvWinXP
  else if ExportsAPI(hKernel32, 'ReplaceFile') then
    Result := wvWin2000
  else if ExportsAPI(hKernel32, 'OpenThread') then
    Result := wvWinME
  else if ExportsAPI(hKernel32, 'GetThreadPriorityBoost') then
    Result := wvWinNT4
  else if ExportsAPI(hKernel32, 'IsDebuggerPresent') then  // is also in NT4!
    Result := wvWin98
  else if ExportsAPI(hKernel32, 'GetDiskFreeSpaceEx') then  // is also in NT4!
    Result := wvWin95OSR2
  else if ExportsAPI(hKernel32, 'ConnectNamedPipe') then
    Result := wvWinNT3
  else if ExportsAPI(hKernel32, 'Beep') then
    Result := wvWin95
  else // we have no idea
    Result := DSiGetWindowsVersion;
end; { DSiGetTrueWindowsVersion }

  {:Returns user name of the current thread.
    @author  Miha-R, Lee_Nover
    @since   2002-11-25
  }
function DSiGetUserName: string;
var
  buffer: PChar;
  bufferSize: DWORD;
begin
  bufferSize := 256; //UNLEN from lmcons.h
  buffer := AllocMem(bufferSize * SizeOf(char));
  try
    GetUserName(buffer, bufferSize);
    Result := string(buffer);
  finally
    FreeMem(buffer, bufferSize);
  end;
end; { DSiGetUserName }

  {:Returns name of the user owning the desktop (currently logged user).
    @author  Lee_Nover
    @since   2003-09-03
  }
function DSiGetUserNameEx: string;
var
  dwProcessId: DWORD;
  h: HWND;
  hProcess: THandle;
  hToken: THandle;
begin
  Result := '';
  h := FindWindow('Progman', nil);// maybe use GetDesktopWindow
  if h = 0 then
    Exit;
  if GetWindowThreadProcessId(h, @dwProcessId) = 0 then
    Exit;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessId);
  if hProcess = 0 then
    Exit;
  try
    if OpenProcessToken(hProcess, TOKEN_ALL_ACCESS, hToken) then
      try
        ImpersonateLoggedOnUser(hToken);
        try
          Result := DSiGetUserName;
        finally
          RevertToSelf;
        end;
      finally
        CloseHandle(hToken);
      end;
  finally
    CloseHandle(hProcess);
  end;
end; { TDSiRegistry.DSiGetUserNameEx }

  {:Returns Windows folder (i.e. C:\Windows or similar).
    @author  Miha-R
    @since   2002-11-25
  }
function DSiGetWindowsFolder: string;
var
  path: PChar;
begin
  GetMem(path, MAX_PATH * SizeOf(char));
  try
    if GetWindowsDirectory(path, MAX_PATH * SizeOf(char)) <> 0 then
      Result := StrPas(path)
    else
      Result := '';
  finally
    FreeMem(path);
  end;
end; { DSiGetWindowsFolder }

  {:Returns detailed Windows version.
    @author  xtreme, ales
    @since   2003-10-09
  }
function DSiGetWindowsVersion: TDSiWindowsVersion;
var
  versionInfo: TOSVersionInfo;
  versionInfoEx: TOSVersionInfoEx;
  versionInfoExFake: TOSVersionInfo absolute versionInfoEx;
begin
  versionInfo.dwOSVersionInfoSize := SizeOf(versionInfo);
  GetVersionEx(versionInfo);
  Result := wvUnknown;
  case versionInfo.dwPlatformID of
    VER_PLATFORM_WIN32s: Result := wvWin31;
    VER_PLATFORM_WIN32_WINDOWS:
      case versionInfo.dwMinorVersion of
        0:
          if Trim(versionInfo.szCSDVersion[1]) = 'B' then
            Result := wvWin95OSR2
          else
            Result := wvWin95;
        10:
          if Trim(versionInfo.szCSDVersion[1]) = 'A' then
            Result := wvWin98SE
          else
            Result := wvWin98;
        90:
          if (versionInfo.dwBuildNumber = 73010104) then
            Result := wvWinME;
        else
          Result := wvWin9x;
      end; //case versionInfo.dwMinorVersion
    VER_PLATFORM_WIN32_NT:
      case versionInfo.dwMajorVersion of
        3: Result := wvWinNT3;
        4: Result := wvWinNT4;
        5:
          case versionInfo.dwMinorVersion of
            0: Result := wvWin2000;
            1: Result := wvWinXP;
            2: Result := wvWinServer2003;
            else
              Result := wvWinNT
          end; //case versionInfo.dwMinorVersion
        6:
        begin
          versionInfoEx.dwOSVersionInfoSize := SizeOf(versionInfoEx);
          GetVersionEx(versionInfoExFake);
          if versionInfoEx.wProductType = VER_NT_WORKSTATION then
            if versionInfoEx.dwMinorVersion = 0 then
              Result := wvWinVista
            else
              Result := wvWin7
          else
          if versionInfoEx.dwMinorVersion = 0 then
            Result := wvWinServer2008
          else
            Result := wvWinServer2008R2;
        end;
      end; //case versionInfo.dwMajorVersion
  end; //versionInfo.dwPlatformID
end; { DSiGetWindowsVersion }

  {:Initializes font to the metrics of a specific GUI element.
    @author  aoven
    @since   2007-11-13
  }
function DSiInitFontToSystemDefault(aFont: TFont; aElement: TDSiUIElement): boolean;
var
  NCM: TNonClientMetrics;
  PLF: PLogFont;
begin
  Result := False;
  NCM.cbSize := SizeOf(TNonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then
  begin
    case aElement of
      ueMenu: PLF := @NCM.lfMenuFont;
      ueMessage: PLF := @NCM.lfMessageFont;
      ueWindowCaption: PLF := @NCM.lfCaptionFont;
      ueStatus: PLF := @NCM.lfStatusFont;
      else
        raise Exception.Create('Unexpected GUI element');
    end;
    aFont.Handle := CreateFontIndirect(PLF^);
    Result := True;
  end;
end; { DSiInitFontToSystemDefault }

  {:Returns True if the application is running with admin privileges.
    Always returns True on Windows 95/98.
    Based on http://www.gumpi.com/Blog/2007/10/02/EKON11PromisedEntry3.aspx.
    @author  gabr
    @since   2002-11-25
  }
function DSiIsAdmin: boolean;
var
  accessToken: THandle;
  administrators: PSID;
  groups:  PTokenGroups;
  iGroup:  integer;
  infoBufferSize: DWORD;
  success: BOOL;
begin
  if not DSiIsWinNT then
    Result := True
  else
  begin
    Result  := False;
    success := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, accessToken);
    if not success then
      if GetLastError = ERROR_NO_TOKEN then
        success := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, accessToken);
    if success then
    begin
      if GetTokenInformation(accessToken, TokenGroups, nil, 0, infoBufferSize) or
        (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
        RaiseLastOSError;
      GetMem(groups, infoBufferSize);
      success := GetTokenInformation(accessToken, TokenGroups,
        groups, infoBufferSize, infoBufferSize);
      CloseHandle(accessToken);
      if success then
      begin
        AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
          SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0,
          0, 0, 0, 0, 0, administrators);
          {$R-}
        for iGroup := 0 to groups.GroupCount - 1 do
          if EqualSid(administrators, groups.Groups[iGroup].Sid) then
          begin
            Result := True;
            break; //for iGroup
          end; //for iGroup
          {$IFDEF RestoreR}{$R+}{$ENDIF}
        FreeSid(administrators);
      end;
      FreeMem(groups);
    end;
  end;
end; { DSiIsAdmin }

  {:Returns True if an administrator is logged onto the system. Always returns True on
    Windows 95/98.
    @author  Miha-R, gabr
    @since   2002-11-25
  }
function DSiIsAdminLoggedOn: boolean;
var
  hSC: SC_HANDLE;
begin
  if not DSiIsWinNT then
    Result := True
  else
  begin
    // try an admin privileged API
    hSC := DSiOpenSCManager(nil, nil, GENERIC_READ or GENERIC_WRITE or
      GENERIC_EXECUTE);
    Result := (hSC <> 0);
    if Result then
      DSiCloseServiceHandle(hSC);
  end;
end; { DSiIsAdminLoggedOn }

  {:Checks if disk is inserted in the specified drive.
    @author  Odisej
    @since   2003-10-09
  }
function DSiIsDiskInDrive(disk: char): boolean;
var
  errorMode: word;
begin
  errorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    Result := (DiskSize(Ord(disk) - Ord('A') + 1) >= 0);
  finally
    SetErrorMode(errorMode);
  end;
end; { DSiIsDiskInDrive }

  {:Checks if program is running on an NT platform.
    @author  Lee_Nover
    @since   2002-11-25
  }
function DSiIsWinNT: boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT);
end; { DSiIsWinNT }

  {:WOW64 is the x86 emulator that allows 32-bit Windows-based applications to run on
    64-bit Windows. A 32-bit application can detect whether it is running under WOW64 by
    calling the IsWow64Process function.
    @author  Miha-R, gabr
    @since   2007-02-11
  }
function DSiIsWow64: boolean;
var
  isWow64: BOOL;
begin
  Result := DSiIsWow64Process(GetCurrentProcess, isWow64);
  if Result then
    Result := isWow64;
end; { DSiIsWow64 }

  {:Verifies local password.
    @author  gabr
    @since   2010-04-08
  }
function DSiVerifyPassword(const username, password: string;
  const domain: string): boolean;
var
  logonHandle: THandle;
begin
  Result := DSiLogonAs(username, password, domain, logonHandle);
  if Result then
    CloseHandle(logonHandle);
end; { DSiVerifyPassword }

{ Install }

function UninstallRoot: HKEY;
begin
  if DSiIsWinNT then
    Result := HKEY_CURRENT_USER
  else
    Result := HKEY_LOCAL_MACHINE;
end; { UninstallRoot }

  {:On Vista+, calls DSiAddApplicationToFirewallExceptionListAdvanced.
    On XP, remaps parameters and calls DSiAddApplicationToFirewallExceptionListXP.
    On lesser Windows, simply returns False. 
    @author  gabr
    @since   2009-10-28
  }
function DSiAddApplicationToFirewallExceptionList(
  const entryName, applicationFullPath: string; resolveConflict: TDSiFwResolveConflict;
  description: string; grouping: string; serviceName: string;
  protocols: TDSiFwIPProtocols; localPorts: string;
  profiles: TDSiFwIPProfiles): boolean;
var
  profile: TDSiFwIPProfile;
  versionInfo: TOSVersionInfo;
begin
  Result := False;
  versionInfo.dwOSVersionInfoSize := SizeOf(versionInfo);
  GetVersionEx(versionInfo);
  if versionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT then
    if (versionInfo.dwMajorVersion = 5) and (versionInfo.dwMinorVersion >= 1) then
    begin
      Result := True;
      for profile := Low(TDSiFwIPProfile) to High(TDSiFwIPProfile) do
        if (((fwProfileAll in profiles) and (profile <> fwProfileCurrent)) or
          (profile in profiles)) and (profile in
          [fwProfileCurrent, fwProfileDomain, fwProfilePrivate]) then
          if not DSiAddApplicationToFirewallExceptionListXP(entryName,
            applicationFullPath, resolveConflict, profile) then
            Result := False;
    end
    else if versionInfo.dwMajorVersion >= 6 then
      Result := DSiAddApplicationToFirewallExceptionListAdvanced(
        entryName, applicationFullPath, resolveConflict, description,
        grouping, serviceName, protocols, localPorts, profiles);
end; { DSiAddApplicationToFirewallExceptionList }

  {:Adds application to the list of firewall exceptions, advanced style (Vista+).
    Based on MSDN example http://msdn.microsoft.com/en-us/library/aa364695(VS.85).aspx.
    For more information on parameters, check http://msdn.microsoft.com/en-us/library/aa365344(VS.85).aspx.
    CoInitialize must be called before using this function.
    @author  gabr
    @since   2009-10-28
  }
function DSiAddApplicationToFirewallExceptionListAdvanced(
  const entryName, applicationFullPath: string; resolveConflict: TDSiFwResolveConflict;
  description: string; grouping: string; serviceName: string;
  protocols: TDSiFwIPProtocols; localPorts: string;
  profiles: TDSiFwIPProfiles): boolean;
var
  fwPolicy2: olevariant;
  profileMask: integer;
  protocol: TDSiFwIPProtocol;
  rule: olevariant;
begin
  Result := False;
  try
    case resolveConflict of
      rcDuplicate:
        {nothing to do};
      rcOverwrite:
        DSiRemoveApplicationFromFirewallExceptionListAdvanced(entryName);
      rcSkip:
        if DSiFindApplicationInFirewallExceptionListAdvanced(entryName, rule) then
        begin
          Result := True;
          Exit;
        end;
      else
        raise Exception.CreateFmt('Unknown resolveConflict value %d',
          [Ord(resolveConflict)]);
    end;
    //http://msdn.microsoft.com/en-us/library/aa366458(VS.85).aspx
    //Windows Firewall with Advanced Security was first released with Windows Vista.
    fwPolicy2 := CreateOLEObject('HNetCfg.FwPolicy2');
    if fwProfileCurrent in profiles then
      profileMask := fwPolicy2.CurrentProfileTypes
    else if fwProfileAll in profiles then
      profileMask := NET_FW_PROFILE2_ALL
    else
    begin
      profileMask := 0;
      if fwProfileDomain in profiles then
        profileMask := profileMask or NET_FW_PROFILE2_DOMAIN;
      if fwProfilePrivate in profiles then
        profileMask := profileMask or NET_FW_PROFILE2_PRIVATE;
      if fwProfilePublic in profiles then
        profileMask := profileMask or NET_FW_PROFILE2_PUBLIC;
    end;
    for protocol := Low(TDSiFwIPProtocol) to High(TDSiFwIPProtocol) do
      if protocol in protocols then
      begin
        rule := CreateOLEObject('HNetCfg.FWRule');
        rule.Name := entryName;
        rule.Description := description;
        rule.ApplicationName := applicationFullPath;
        if protocol = fwProtoTCP then
          rule.Protocol := NET_FW_IP_PROTOCOL_TCP
        else if protocol = fwProtoUDP then
          rule.Protocol := NET_FW_IP_PROTOCOL_UDP
        else
          raise Exception.Create('DSiAddApplicationToFirewallExceptionListAdvanced: ' +
            'Unexpected protocol!');
        rule.LocalPorts := localPorts;
        rule.Enabled := True;
        rule.Grouping := grouping;
        rule.Profiles := profileMask;
        rule.Action := NET_FW_ACTION_ALLOW;
        if serviceName <> '' then
          rule.ServiceName := serviceName;
        fwPolicy2.Rules.Add(rule);
      end;
    Result := True;
  except
    on E: EOleSysError do
      SetLastError(cardinal(E.ErrorCode));
    else
      SetLastError(ERROR_INVALID_FUNCTION);
  end;
end; { DSiAddApplicationToFirewallExceptionListAdvanced }

  {:Adds application to the list of firewall exceptions, XP style. Based on the code at
    http://www.delphi3000.com/articles/article_5021.asp?SK=.
    MSDN: http://msdn.microsoft.com/en-us/library/aa366449(VS.85).aspx
    CoInitialize must be called before using this function.
    @author  gabr
    @since   2009-02-05
  }
function DSiAddApplicationToFirewallExceptionListXP(
  const entryName, applicationFullPath: string; resolveConflict: TDSiFwResolveConflict;
  profile: TDSiFwIPProfile): boolean;
var
  app: olevariant;
  fwMgr: olevariant;
  fwProfile: olevariant;
begin
  Result := False;
  try
    case resolveConflict of
      rcDuplicate:
        {nothing to do};
      rcOverwrite:
        DSiRemoveApplicationFromFirewallExceptionListXP(entryName, profile);
      rcSkip:
        if DSiFindApplicationInFirewallExceptionListXP(entryName, app, profile) then
        begin
          Result := True;
          Exit;
        end;
      else
        raise Exception.CreateFmt('Unknown resolveConflict value %d',
          [Ord(resolveConflict)]);
    end;
    fwMgr := CreateOLEObject('HNetCfg.FwMgr');
    if profile = fwProfileCurrent then
      fwProfile := fwMgr.LocalPolicy.CurrentProfile
    else if profile = fwProfileDomain then
      fwProfile := fwMgr.LocalPolicy.GetProfileByType(NET_FW_PROFILE_DOMAIN)
    else if profile = fwProfilePrivate {alias for 'standard'} then
      fwProfile := fwMgr.LocalPolicy.GetProfileByType(NET_FW_PROFILE_STANDARD);
    app := CreateOLEObject('HNetCfg.FwAuthorizedApplication');
    app.ProcessImageFileName := DSiGetSubstPath(applicationFullPath);
    app.Name  := EntryName;
    app.Scope := NET_FW_SCOPE_ALL;
    app.IpVersion := NET_FW_IP_VERSION_ANY;
    app.Enabled := True;
    fwProfile.AuthorizedApplications.Add(app);
    Result := True;
  except
    on E: EOleSysError do
      SetLastError(cardinal(E.ErrorCode));
    else
      SetLastError(ERROR_INVALID_FUNCTION);
  end;
end; { DSiAddApplicationToFirewallExceptionListXP }

  {:Adds application to the list of firewall exceptions. Based on the code at
    http://www.delphi3000.com/articles/article_5021.asp?SK=.
    CoInitialize must be called before using this function.
    @author  gabr
    @since   2009-02-05
  }
function DSiAddPortToFirewallExceptionList(const entryName: string;
  portNumber: cardinal): boolean;
var
  fwMgr: olevariant;
  port:  olevariant;
  profile: olevariant;
begin
  Result := False;
  try
    fwMgr := CreateOLEObject('HNetCfg.FwMgr');
    profile := fwMgr.LocalPolicy.CurrentProfile;
    port  := CreateOLEObject('HNetCfg.FWOpenPort');
    port.Name := EntryName;
    port.Protocol := NET_FW_IP_PROTOCOL_TCP;
    port.Port := PortNumber;
    port.Scope := NET_FW_SCOPE_ALL;
    port.Enabled := True;
    profile.GloballyOpenPorts.Add(port);
    Result := True;
  except
    on E: EOleSysError do
      SetLastError(cardinal(E.ErrorCode));
  end;
end; { DSiAddPortToFirewallExceptionList }

{gp}
function DSiAddUninstallInfo(
  const displayName, uninstallCommand, publisher, URLInfoAbout,
  displayVersion, helpLink, URLUpdateInfo: string): boolean;
begin
  Result := False;
  with TRegistry.Create do
    try
      RootKey := UninstallRoot;
      if OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' +
        displayName, True) then
        try
          WriteString('DisplayName', displayName);
          WriteString('UninstallString', uninstallCommand);
          if publisher <> '' then
            WriteString('Publisher', publisher);
          if URLInfoAbout <> '' then
            WriteString('URLInfoAbout', URLInfoAbout);
          if displayVersion <> '' then
            WriteString('DisplayVersion', displayVersion);
          if helpLink <> '' then
            WriteString('HelpLink', helpLink);
          if URLUpdateInfo <> '' then
            WriteString('URLUpdateInfo', URLUpdateInfo);
          Result := True;
        finally
          CloseKey;
        end;
    finally
      {TRegistry.}Free;
    end;
end; { DSiAddUninstallInfo }

{ln}
function DSiAutoRunApp(const applicationName, applicationPath: string;
  Enabled: boolean): boolean;
begin
  Result := False;
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True) then
        try
          if Enabled then
            WriteString(applicationName, applicationPath)
          else
            DeleteValue(applicationname);
          Result := True;
        finally
          CloseKey;
        end;
    finally
      {TRegistry.}Free;
    end;
end; { DSiAutoRunApp }

 {gp}
 // stolen from RXLib
procedure DSiCreateShortcut(const fileName, displayName, parameters: string;
  folder: integer; const workDir: string);
var
  fileDestPath: array [0..MAX_PATH] of char;
  itemIDList: PItemIDList;
  persistFile: IPersistFile;
  shellLink: IShellLink;
    {$IFNDEF Unicode}
  fileNameW: array [0..MAX_PATH] of widechar;
    {$ENDIF}
begin
  CoInitialize(nil);
  try
    OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
      IID_IShellLinkA, shellLink));
    OleCheck(shellLink.QueryInterface(IID_IPersistFile, persistFile));
    OleCheck(SHGetSpecialFolderLocation(0, folder, itemIDList));
    SHGetPathFromIDList(itemIDList, fileDestPath);
    StrCat(fileDestPath, PChar('\' + displayName + CLinkExt));
    shellLink.SetPath(PChar(fileName));
    shellLink.SetIconLocation(PChar(fileName), 0);
    shellLink.SetWorkingDirectory(PChar(workDir));
    shellLink.SetArguments(PChar(parameters));
      {$IFDEF Unicode}
        OleCheck(persistFile.Save(fileDestPath, true));
      {$ELSE}
    MultiByteToWideChar(CP_ACP, 0, fileDestPath, -1, fileNameW, MAX_PATH);
    OleCheck(persistFile.Save(fileNameW, True));
      {$ENDIF Unicode}
  finally
    CoUninitialize;
  end;
end; { DSiCreateShortcut }

{gp}
function DSiDeleteShortcut(const displayName: string; folder: integer): boolean;
var
  path: string;
begin
  Result := False;
  path := DSiGetFolderLocation(folder);
  if path <> '' then
  begin
    path := path + '\' + displayName + CLinkExt;
    Result := DSiKillFile(path);
  end;
end; { DSiDeleteShortcut }

  {:Edits shortcut info.
    @author  Fora
    @since   2006-06-20
  }
procedure DSiEditShortcut(const lnkName, fileName, workDir, parameters: string);
var
  persistFile: IPersistFile;
  shellLink: IShellLink;
    {$IFNDEF Unicode}
  fileNameW: array [0..MAX_PATH] of widechar;
    {$ENDIF}
begin
  CoInitialize(nil);
  try
    OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
      IID_IShellLinkA, shellLink));
    OleCheck(shellLink.QueryInterface(IID_IPersistFile, persistFile));
    if (shellLink as IPersistFile).Load(PWideChar(WideString(lnkName)), 0) = 0 then
    begin
      shellLink.SetPath(PChar(fileName));
      shellLink.SetWorkingDirectory(PChar(workDir));
      shellLink.SetArguments(PChar(parameters));
        {$IFDEF Unicode}
          OleCheck(persistFile.Save(PChar(lnkName), true));
        {$ELSE}
      MultiByteToWideChar(CP_ACP, 0, PChar(lnkName), -1, fileNameW, MAX_PATH);
      OleCheck(persistFile.Save(fileNameW, True));
        {$ENDIF Unicode}
    end;
  finally
    CoUninitialize;
  end;
end; { DSiEditShortcut }

  {:Finds rule in the firewall exception list, advanced style (Vista+).
    CoInitialize must be called before using this function.
    @author  gabr
    @since   2010-07-27
  }
function DSiFindApplicationInFirewallExceptionListAdvanced(const entryName: string;
  var rule: olevariant): boolean;
var
  fwPolicy2: olevariant;
  ruleEnum: IEnumVariant;
  Value: cardinal;
begin
  Result := False;
  fwPolicy2 := CreateOLEObject('HNetCfg.FwPolicy2');
  if IUnknown(fwPolicy2.Rules._NewEnum).QueryInterface(IEnumVariant,
    ruleEnum) <> S_OK then
    Exit;
  while (ruleEnum.Next(1, rule, Value) = S_OK) do
    if SameText(entryName, rule.Name) then
    begin
      Result := True;
      Exit;
    end;
  rule := Null;
end; { DSiFindApplicationInFirewallExceptionListAdvanced }

  {:Finds rule in the firewall exception lis (XP).
    CoInitialize must be called before using this function.
    @author  gabr
    @since   2010-07-27
  }
function DSiFindApplicationInFirewallExceptionListXP(const entryName: string;
  var application: olevariant; profile: TDSiFwIPProfile): boolean;
var
  fwMgr: olevariant;
  fwProfile: olevariant;
  ruleEnum: IEnumVariant;
  Value: cardinal;
begin
  Result := False;
  fwMgr  := CreateOLEObject('HNetCfg.FwMgr');
  if profile = fwProfileDomain then
    fwProfile := fwMgr.LocalPolicy.GetProfileByType(NET_FW_PROFILE_DOMAIN)
  else if profile = fwProfilePrivate {alias for 'standard'} then
    fwProfile := fwMgr.LocalPolicy.GetProfileByType(NET_FW_PROFILE_STANDARD)
  else
    fwProfile := fwMgr.LocalPolicy.CurrentProfile;
  if IUnknown(fwProfile.AuthorizedApplications._NewEnum).QueryInterface(
    IEnumVariant, ruleEnum) <> S_OK then
    Exit;
  while (ruleEnum.Next(1, application, Value) = S_OK) do
    if SameText(entryName, application.Name) then
    begin
      Result := True;
      Exit;
    end;
  application := Null;
end; { DSiFindApplicationInFirewallExceptionListXP }

  {$R-}
function DSiGetLogonSID(token: THandle; var logonSID: PSID): boolean;
var
  dwLength: DWORD;
  iGroup: integer;
  tkGroups: ^TOKEN_GROUPS;
begin
  Result := False;
  dwLength := 0;
  tkGroups := nil;
  try
    if not GetTokenInformation(token, TokenGroups, tkGroups, 0, dwLength) then
    begin
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
        Exit;
      tkGroups := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwLength);
      if tkGroups = nil then
        Exit;
      if not GetTokenInformation(token, TokenGroups, tkGroups, dwLength, dwLength) then
        Exit;
      // Loop through the groups to find the logon SID.
      for iGroup := 0 to tkGroups.GroupCount - 1 do
        if (tkGroups.Groups[iGroup].Attributes and SE_GROUP_LOGON_ID) =
          SE_GROUP_LOGON_ID then
        begin
          dwLength := GetLengthSid(tkGroups.Groups[iGroup].Sid);
          logonSID := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwLength);
          if logonSID = nil then
            Exit;
          if not CopySid(dwLength, logonSID, tkGroups.Groups[iGroup].Sid) then
          begin
            HeapFree(GetProcessHeap, 0, logonSID);
            Exit;
          end;
          break; //for iGroup
        end//for iGroup
      ;
      Result := True;
    end;
  finally
    if assigned(tkGroups) then
      HeapFree(GetProcessHeap, 0, tkGroups);
  end;
end;

{ DSiGetLogonSID }
  {$IFDEF RestoreR}{$R+}{$ENDIF}

  {:Extracts executable path and work dir from the LNK file.
    @author  Cavlji
    @since   2006-06-20
  }
function DSiGetShortcutInfo(const lnkName: string;
  var fileName, filePath, workDir, parameters: string): boolean;
var
  buf: array [0..MAX_PATH] of char;
  param: array[0..MAX_PATH] of char;
  findData: TWin32FindData;
  shellLink: IShellLink;
begin
  CoInitialize(nil);
  try
    Result := False;
    OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
      IID_IShellLinkA, shellLink));
    if (shellLink as IPersistFile).Load(PWideChar(WideString(lnkName)), 0) = 0 then
    begin
      shellLink.GetPath(buf, MAX_PATH, findData, 0);
      fileName := findData.cFileName;
      filePath := buf;
      shellLink.GetWorkingDirectory(buf, MAX_PATH);
      shellLink.GetArguments(param, MAX_PATH);
      parameters := param;
      workDir := buf;
      Result  := True;
    end;
  finally
    CoUninitialize;
  end;
end; { DSiGetShortcutInfo }

{gp}
function DSiGetUninstallInfo(const displayName: string;
  out uninstallCommand: string): boolean;
begin
  uninstallCommand :=
    DSiReadRegistry('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' +
    displayName, 'UninstallString', '', UninstallRoot);
  Result := (uninstallCommand <> '');
end; { DSiGetUninstallInfo }

{ln}
function DSiIsAutoRunApp(const applicationname: string): boolean;
begin
  Result :=
    (DSiReadRegistry('\Software\Microsoft\Windows\CurrentVersion\Run',
    applicationname, '') <> '');
end; { DSiIsAutoRunApp }

{ln}
function DSiRegisterActiveX(const fileName: string; registerDLL: boolean): HRESULT;
type
  TDLLRegisterServer = function: HResult; stdcall;
var
  _Register: TDllRegisterServer;
  DLLHandle: THandle;
  OldMode: DWORD;
begin
  Result  := E_FAIL;
  OldMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  DLLHandle := LoadLibrary(PChar(FileName));
  SetErrorMode(OldMode);
  if DLLHandle > 0 then
    try
      if RegisterDLL then
        _Register := GetProcAddress(DLLHandle, 'DllRegisterServer')
      else
        _Register := GetProcAddress(DLLHandle, 'DllUnregisterServer');
      if Assigned(_Register) then
        Result := _Register
      else
        Result := E_NOTIMPL;
    finally
      FreeLibrary(DLLHandle);
    end;
end; { DSiRegisterActiveX }

{gp}
procedure DSiRegisterRunOnce(const applicationName, applicationPath: string);
begin
  DSiWriteRegistry('SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce',
    applicationName, applicationPath);
end; { DSiRegisterRunOnce }

  {:On Vista+, calls DSiRemoveApplicationFromFirewallExceptionListAdvanced.
    On XP, remaps parameters and calls DSiRemoveApplicationFromFirewallExceptionListXP.
    On lesser Windows, simply returns False.
    @author  gabr
    @since   2009-10-28
  }
function DSiRemoveApplicationFromFirewallExceptionList(
  const entryName, applicationFullPath: string): boolean;
var
  versionInfo: TOSVersionInfo;
begin
  Result := False;
  versionInfo.dwOSVersionInfoSize := SizeOf(versionInfo);
  GetVersionEx(versionInfo);
  if versionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT then
    if (versionInfo.dwMajorVersion = 5) and (versionInfo.dwMinorVersion >= 1) then
      Result := DSiRemoveApplicationFromFirewallExceptionListXP(applicationFullPath)
    else if versionInfo.dwMajorVersion >= 6 then
      Result := DSiRemoveApplicationFromFirewallExceptionListAdvanced(entryName);
end; { DSiRemoveApplicationFromFirewallExceptionList }

  {:Removes application from the firewall exception list, advanced style (Vista+).
    @author  gabr
    @since   2009-10-28
  }
function DSiRemoveApplicationFromFirewallExceptionListAdvanced(
  const entryName: string): boolean;
var
  fwPolicy2: olevariant;
begin
  Result := False;
  try
    fwPolicy2 := CreateOLEObject('HNetCfg.FwPolicy2');
    fwPolicy2.Rules.Remove(entryName);
    Result := True;
  except
    on E: EOleSysError do
      SetLastError(cardinal(E.ErrorCode));
    else
      SetLastError(ERROR_INVALID_FUNCTION);
  end;
end; { DSiRemoveApplicationFromFirewallExceptionListAdvanced }

  {:Removes application from the firewall exception list, XP style.
    @author  gabr
    @since   2009-10-28
  }
function DSiRemoveApplicationFromFirewallExceptionListXP(
  const applicationFullPath: string): boolean;
var
  profile: TDSiFwIPProfile;
  removeResult: boolean;
begin
  Result := False;
  for profile := fwProfileDomain to fwProfilePublic do
  begin
    removeResult := DSiRemoveApplicationFromFirewallExceptionListXP(
      applicationFullPath, profile);
    Result := Result or removeResult;
  end;
end; { DSiRemoveApplicationFromFirewallExceptionListXP }

  {:Removes application from a specific profile in the firewall exception list, XP style.
    @author  gabr
    @since   2010-07-27
  }
function DSiRemoveApplicationFromFirewallExceptionListXP(
  const applicationFullPath: string; profile: TDSiFwIPProfile): boolean;
var
  fwMgr: olevariant;
  fwProfile: olevariant;
begin
  Result := False;
  try
    fwMgr := CreateOLEObject('HNetCfg.FwMgr');
    if profile = fwProfileDomain then
      fwProfile := fwMgr.LocalPolicy.GetProfileByType(NET_FW_PROFILE_DOMAIN)
    else if profile = fwProfilePrivate {alias for 'standard'} then
      fwProfile := fwMgr.LocalPolicy.GetProfileByType(NET_FW_PROFILE_STANDARD)
    else
      fwProfile := fwMgr.LocalPolicy.CurrentProfile;
    Result := fwProfile.AuthorizedApplications.Remove(
      DSiGetSubstPath(applicationFullPath)) = S_OK;
  except
    on E: EOleSysError do
      SetLastError(cardinal(E.ErrorCode));
    else
      SetLastError(ERROR_INVALID_FUNCTION);
  end;
end; { DSiRemoveApplicationFromFirewallExceptionListXP }

{gp}
procedure DSiRemoveRunOnce(const applicationName: string);
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce', True) then
        try
          DeleteValue(applicationName);
        finally
          CloseKey;
        end;
    finally
      {TRegistry.}Free;
    end;
end; { DSiRemoveRunOnce }

{gp}
function DSiRemoveUninstallInfo(const displayName: string): boolean;
begin
  Result :=
    DSiKillRegistry('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' +
    displayName, UninstallRoot);
end; { DSiRemoveUninstallInfo }

{gp}
function DSiShortcutExists(const displayName: string; folder: integer): boolean;
var
  path: string;
begin
  path := DSiGetFolderLocation(folder);
  if path <> '' then
  begin
    path := path + '\' + displayName + CLinkExt;
    Result := FileExists(path);
  end
  else
    Result := False;
end; { DSiShortcutExists }

{ Time }

threadvar
  GLastTimeGetTime: DWORD;
  GTimeGetTimeBase: int64;

var
  GPerformanceFrequency: int64;

constructor TDSiTimer.Create(Enabled: boolean; interval: cardinal;
  onTimer: TNotifyEvent; tag: longint);
begin
  inherited Create;
  dtEnabled := Enabled;
  dtInterval := interval;
  dtOnTimer := onTimer;
  dtTag := tag;
  dtWindowHandle := DSiAllocateHWnd(WndProc);
  UpdateTimer;
end; { TDSiTimer.Create }

destructor TDSiTimer.Destroy;
begin
  dtEnabled := False;
  UpdateTimer;
  DSiDeallocateHWnd(dtWindowHandle);
  inherited;
end; { TDSiTimer.Destroy }

procedure TDSiTimer.SetEnabled(Value: boolean);
begin
  if Value <> dtEnabled then
  begin
    dtEnabled := Value;
    UpdateTimer;
  end;
end; { TDSiTimer.SetEnabled }

procedure TDSiTimer.SetInterval(Value: cardinal);
begin
  if Value <> dtInterval then
  begin
    dtInterval := Value;
    UpdateTimer;
  end;
end; { TDSiTimer.SetInterval }

procedure TDSiTimer.SetOnTimer(Value: TNotifyEvent);
begin
  dtOnTimer := Value;
  UpdateTimer;
end; { TDSiTimer.SetOnTimer }

procedure TDSiTimer.UpdateTimer;
begin
  KillTimer(dtWindowHandle, 1);
  if (Interval <> 0) and Enabled and Assigned(OnTimer) then
    if SetTimer(dtWindowHandle, 1, Interval, nil) = 0 then
      RaiseLastOSError;
end; { TDSiTimer.UpdateTimer }

procedure TDSiTimer.WndProc(var msgRec: TMessage);
begin
  with msgRec do
    if Msg = WM_TIMER then
    begin
      if Assigned(OnTimer) then
        OnTimer(Self);
    end
    else
      Result := DefWindowProc(dtWindowHandle, Msg, wParam, lParam); //with msgRec
end; { TDSiTimer.WndProc }

  {:Converts time from Delphi TDateTime format to Windows TFileTime format.
    @returns false if conversion failed.
    @author  gabr
    @since   2012-02-06
  }
function DSiDateTimeToFileTime(dateTime: TDateTime; var fileTime: TFileTime): boolean;
var
  sysTime: TSystemTime;
begin
  DateTimeToSystemTime(dateTime, sysTime);
  Result := SystemTimeToFileTime(sysTime, fileTime);
end; { DSiDateTimeToFileTime }

{gp}
function DSiElapsedSince(midTime, startTime: int64): int64;
begin
  if midTime < startTime then
    midTime := midTime + $100000000;
  Result := midTime - startTime;
end; { TDSiRegistry.DSiElapsedSince }

  {:Returns time elapsed since startTime, which must be a result of the GetTickCount.
  }
function DSiElapsedTime(startTime: int64): int64;
begin
  Result := DSiElapsedSince(GetTickCount, startTime);
end; { DSiElapsedTime }

  {:Returns time elapsed since startTime, which must be a result of the DSiTimeGetTime64.
  }
function DSiElapsedTime64(startTime: int64): int64;
begin
  Result := DSiTimeGetTime64 - startTime;
end; { DSiElapsedTime64 }

  {:Converts time from Windows TFileTime format to Delphi TDateTime format.
    @returns 0 if conversion failed.
    @author  gabr
    @since   2006-12-20
  }
function DSiFileTimeToDateTime(fileTime: TFileTime): TDateTime;
begin
  if not DSiFileTimeToDateTime(fileTime, Result) then
    Result := 0;
end; { DSiFileTimeToDateTime }

  {:Converts time from Windows TFileTime format to Delphi TDateTime format.
    @returns false if conversion failed.
    @author  gabr
    @since   2006-12-20
  }
function DSiFileTimeToDateTime(fileTime: TFileTime; var dateTime: TDateTime): boolean;
var
  sysTime: TSystemTime;
begin
  Result := FileTimeToSystemTime(fileTime, sysTime);
  if Result then
    dateTime := SystemTimeToDateTime(sysTime);
end; { DSiFileTimeToDateTime }

  {:Converts TFileTime structure containing nanoseconds (user and kernel time returned
    from GetProcessTimes, for example) into int64 containing microseconds.
    @since   2006-12-20
  }
function DSiFileTimeToMicroSeconds(fileTime: TFileTime): int64;
begin
  Int64Rec(Result).Lo := fileTime.dwLowDateTime;
  Int64Rec(Result).Hi := fileTime.dwHighDateTime;
  Result := Result div 10;
end; { DSiFileTimeToMicroSeconds }

  {:Checks whether the specified timeout_ms period has elapsed. Start time must be a value
    returned from the GetTickCount.
  }
function DSiHasElapsed(startTime: int64; timeout_ms: DWORD): boolean;
begin
  if timeout_ms = 0 then
    Result := True
  else if timeout_ms = INFINITE then
    Result := False
  else
    Result := (DSiElapsedTime(startTime) > timeout_ms);
end; { DSiHasElapsed }

  {:Checks whether the specified timeout_ms period has elapsed. Start time must be a value
    returned from the DSiTimeGetTime64.
  }
function DSiHasElapsed64(startTime: int64; timeout_ms: DWORD): boolean;
begin
  if timeout_ms = 0 then
    Result := True
  else if timeout_ms = INFINITE then
    Result := False
  else
    Result := (DSiElapsedTime64(startTime) > timeout_ms);
end; { DSiHasElapsed64 }

  {:Converts value returned from QueryPerformanceCounter to milliseconds.
    @author  gabr
    @since   2007-12-03
  }
function DSiPerfCounterToMS(perfCounter: int64): int64;
begin
  Result := 0;
  if GPerformanceFrequency > 0 then
    Result := Round(perfCounter / GPerformanceFrequency * 1000);
end; { DSiPerfCounterToMS }

  {:Converts value returned from QueryPerformanceCounter to microseconds.
    @author  gabr
    @since   2007-12-03
  }
function DSiPerfCounterToUS(perfCounter: int64): int64;
begin
  Result := 0;
  if GPerformanceFrequency > 0 then
    Result := Round(perfCounter / GPerformanceFrequency * 1000000);
end; { DSiPerfCounterToUS }

  {:Calls QueryPerformanceCounter and returns the result as microseconds.
    @author  gabr
    @since   2007-12-03
  }
function DSiQueryPerfCounterAsUS: int64;
begin
  if QueryPerformanceCounter(Result) then
    Result := DSiPerfCounterToUS(Result)
  else
    Result := 0;
end; { DSiQueryPerfCounterAsUS }

  {:64-bit extension of MM timeGetTime. Time units are milliseconds.
    @author  gabr
    @since   2007-11-26
  }
function DSiTimeGetTime64: int64;
begin
  Result := timeGetTime;
  if Result < GLastTimeGetTime then
    GTimeGetTimeBase := GTimeGetTimeBase + $100000000;
  GLastTimeGetTime := Result;
  Result := Result + GTimeGetTimeBase;
end; { DSiTimeGetTime64 }

 {ales, Brdaws}
 //'delay' is in microseconds
procedure DSiuSecDelay(delay: int64);
var
  dif:  int64;
  endTime: TLargeInteger;
  freq: TLargeInteger;
  nowTime: TLargeInteger;
begin
  QueryPerformanceFrequency(freq);
  dif := delay * freq div 1000000;
  QueryPerformanceCounter(endTime);
  endTime := endTime + dif;
  repeat
    QueryPerformanceCounter(nowTime);
  until nowTime >= endTime;
end; { DSiuSecDelay }

{ Interlocked }

function DSiInterlockedDecrement64(var addend: int64): int64; register;
asm
{$IFDEF CPUX64}
  MOV   RAX, DWORD - 1
  LOCK XADD [ADDEND], RAX
  DEC   RAX
{$ELSE}
  {     ->          EAX     addend }
  {     <-          EDX:EAX Result }
  PUSH    EDI
  PUSH    EBX

  MOV     EDI, EAX

  MOV     EAX, [EDI]    // Fetch original int64 at memory location
  MOV     EDX, [EDI+4]
  @@1:
  MOV     ECX, EDX
  MOV     EBX, EAX

  SUB     EBX, 1
  SBB     ECX, 0

  LOCK      CMPXCHG8B [EDI]
  JNZ     @@1

  { Returns updated value of addend }
  MOV     EAX, EBX
  MOV     EDX, ECX

  POP     EBX
  POP     EDI
{$ENDIF ~CPUX64}
end; { DSiInterlockedDecrement64 }

function DSiInterlockedIncrement64(var addend: int64): int64;
asm
{$IFDEF CPUX64}
  MOV   RAX, 1
  LOCK XADD [ADDEND], RAX
  INC   RAX
{$ELSE}
  {     ->          EAX     addend }
  {     <-          EDX:EAX Result }
  PUSH    EDI
  PUSH    EBX

  MOV     EDI, EAX

  MOV     EAX, [EDI]    // Fetch original int64 at memory location
  MOV     EDX, [EDI+4]
  @@1:
  MOV     ECX, EDX
  MOV     EBX, EAX

  ADD     EBX, 1
  ADC     ECX, 0

  LOCK      CMPXCHG8B [EDI]
  JNZ     @@1

  { Returns updated value of addend }
  MOV     EAX, EBX
  MOV     EDX, ECX

  POP     EBX
  POP     EDI
{$ENDIF ~CPUX64}
end; { DSiInterlockedIncrement64 }

function DSiInterlockedExchangeAdd64(var addend: int64; Value: int64): int64;
asm
{$IFDEF CPUX64}
  MOV   RAX, VALUE
  LOCK  XADD [ADDEND], VALUE
  MOV   RAX, VALUE
{$ELSE}
  {     ->          EAX     addend }
  {                 ESP+4   value  }
  {     <-          EDX:EAX Result }

  PUSH    EDI
  PUSH    ESI
  PUSH    EBP
  PUSH    EBX

  MOV     ESI, DWORD PTR [value]    // EDI:ESI = value
  MOV     EDI, DWORD PTR [value+4]
  MOV     EBP, EAX

  MOV     EAX, [EBP]    // EDX:EAX = addend (fetch original int64 value)
  MOV     EDX, [EBP+4]
  @@1:
  MOV     ECX, EDX      // ECX:EBX = addend
  MOV     EBX, EAX

  ADD     EBX, ESI
  ADC     ECX, EDI

  LOCK      CMPXCHG8B [EBP]
  JNZ     @@1
  // Returns initial value in addend

  POP     EBX
  POP     EBP
  POP     ESI
  POP     EDI
{$ENDIF ~CPUX64}
end; { DSiInterlockedExchangeAdd64 }

function DSiInterlockedExchange64(var target: int64; Value: int64): int64;
asm
{$IFDEF CPUX64}
  LOCK  XCHG    [TARGET], VALUE
  MOV   RAX, VALUE
{$ELSE}
  {     ->          EAX     target }
  {                 ESP+4   value  }
  {     <-          EDX:EAX Result }
  PUSH    EDI
  PUSH    EBX

  MOV     EDI, EAX

  MOV     EAX, [EDI]
  MOV     EDX, [EDI+4]

  MOV     EBX, DWORD PTR [value]
  MOV     ECX, DWORD PTR [value+4]
  @@1:
  LOCK      CMPXCHG8B [EDI]
  JNZ     @@1
  // Returns initial value in target

  POP     EBX
  POP     EDI
{$ENDIF ~CPUX64}
end; { DSiInterlockedExchange64 }

function DSiInterlockedCompareExchange64(var destination: int64;
  exchange, comparand: int64): int64;
asm
{$IFDEF CPUX64}
  MOV   RAX, COMPARAND
  LOCK CMPXCHG [DESTINATION], EXCHANGE
{$ELSE}
  {     ->          EAX     destination }
  {                 ESP+4   exchange    }
  {                 ESP+12  comparand   }
  {     <-          EDX:EAX Result      }
  PUSH    EBX
  PUSH    EDI

  MOV     EDI, EAX

  MOV     EAX, DWORD PTR [comparand]
  MOV     EDX, DWORD PTR [comparand+4]

  MOV     EBX, DWORD PTR [exchange]
  MOV     ECX, DWORD PTR [exchange+4]

  LOCK      CMPXCHG8B [EDI]

  POP     EDI
  POP     EBX
{$ENDIF ~CPUX64}
end; { DSiInterlockedCompareExchange64 }

function DSiInterlockedCompareExchange64(destination: PInt64;
  exchange, comparand: int64): int64;
asm
{$IFDEF CPUX64}
  MOV   RAX, COMPARAND
  LOCK CMPXCHG [DESTINATION], EXCHANGE
{$ELSE}
  {     ->          EAX     destination }
  {                 ESP+4   exchange    }
  {                 ESP+12  comparand   }
  {     <-          EDX:EAX Result      }
  PUSH    EBX
  PUSH    EDI

  MOV     EDI, EAX

  MOV     EAX, DWORD PTR [comparand]
  MOV     EDX, DWORD PTR [comparand+4]

  MOV     EBX, DWORD PTR [exchange]
  MOV     ECX, DWORD PTR [exchange+4]

  LOCK      CMPXCHG8B [EDI]

  POP     EDI
  POP     EBX
{$ENDIF ~CPUX64}
end; { DSiInterlockedCompareExchange64 }

{ DynaLoad }

var
  _GLibraryList: TStringList = nil;

function GLibraryList: TStringList;
begin
  if not assigned(_GLibraryList) then
    _GLibraryList := TStringList.Create;
  Result := _GLibraryList;
end; { GLibraryList }

  {:Loads library and adds library handle to the list of handles that must be
    unloaded at process termination. Caches library handle for future reference.
    @since   2003-09-02
  }
function DSiLoadLibrary(const libFileName: string): HMODULE;
var
  hLib: HMODULE;
  idxLib: integer;
  OldMode: DWORD;
begin
  idxLib := GLibraryList.IndexOf(libFileName);
  if idxLib < 0 then
  begin
    OldMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
    hLib := LoadLibrary(PChar(libFileName));
    SetErrorMode(OldMode);
    if hLib <> 0 then
      idxLib := GLibraryList.AddObject(libFileName, TObject(hLib));
  end;
  if idxLib >= 0 then
    Result := HMODULE(GLibraryList.Objects[idxLib])
  else
    Result := 0;
end; { DSiLoadLibrary }

  {:Loads the library if it was not loaded yet (and adds it to the list of
    libraries that must be unloaded at process termination), then calls
    GetProcAddress.
    @since   2003-09-02
  }
function DSiGetProcAddress(const libFileName, procName: string): FARPROC;
begin
  Result := GetProcAddress(DSiLoadLibrary(libFileName), PChar(procName));
end; { DSiGetProcAddress }

  {:Unloads all loaded libraries.
    @since   2003-09-02
  }
procedure DSiUnloadLibrary;
var
  iLib: integer;
begin
  for iLib := 0 to GLibraryList.Count - 1 do
    if HMODULE(GLibraryList.Objects[iLib]) <> 0 then
    begin
      FreeLibrary(HMODULE(GLibraryList.Objects[iLib]));
      GLibraryList.Objects[iLib] := TObject(0);
    end;
end; { TDSiRegistry.DSiUnloadLibrary }

function DSi9xNetShareAdd(serverName: PChar; shareLevel: smallint;
  buffer: pointer; size: word): integer;
begin
  if not assigned(G9xNetShareAdd) then
    G9xNetShareAdd := DSiGetProcAddress('svrapi.dll', 'NetShareAdd');
  if assigned(G9xNetShareAdd) then
    Result := G9xNetShareAdd(serverName, shareLevel, buffer, size)
  else
    Result := ERROR_NOT_SUPPORTED;
end; { DSi9xNetShareAdd }

function DSi9xNetShareDel(serverName: PChar; netName: PChar; reserved: word): integer;
begin
  if not assigned(G9xNetShareDel) then
    G9xNetShareDel := DSiGetProcAddress('svrapi.dll', 'NetShareDel');
  if assigned(G9xNetShareDel) then
    Result := G9xNetShareDel(serverName, netName, reserved)
  else
    Result := ERROR_NOT_SUPPORTED;
end; { DSi9xNetShareDel }

function DSiCloseServiceHandle(hSCObject: SC_HANDLE): BOOL;
begin
  if not assigned(GCloseServiceHandle) then
    GCloseServiceHandle := DSiGetProcAddress('advapi32.dll', 'CloseServiceHandle');
  if assigned(GCloseServiceHandle) then
    Result := GCloseServiceHandle(hSCObject)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiCloseServiceHandle }

function DSiCreateProcessAsUser(hToken: THandle;
  lpApplicationName, lpCommandLine: PChar;
  lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
  bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: pointer;
  lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL;
  {$IFDEF Unicode}
  var
    commandLine: string;
  {$ENDIF Unicode}
begin
    {$IFDEF Unicode}
      commandLine := lpCommandLine;
      {$IFDEF Unicode}UniqueString(commandLine);{$ENDIF Unicode}
      Result := CreateProcessAsUser(hToken, lpApplicationName, PChar(commandLine),
        lpProcessAttributes, lpThreadAttributes, bInheritHandles,
        dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo,
        lpProcessInformation);
    {$ELSE}
  if not assigned(GCreateProcessAsUser) then
    GCreateProcessAsUser :=
      DSiGetProcAddress('advapi32.dll', 'CreateProcessAsUserA');
  if assigned(GCreateProcessAsUser) then
    Result := GCreateProcessAsUser(hToken, lpApplicationName,
      lpCommandLine, lpProcessAttributes, lpThreadAttributes,
      bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory,
      lpStartupInfo, lpProcessInformation)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
    {$ENDIF Unicode}
end; { DSiCreateProcessAsUser }

function DSiCreateProcessWithLogonW(lpUsername, lpDomain, lpPassword: PWideChar;
  dwLogonFlags: DWORD; lpApplicationName, lpCommandLine: PWideChar;
  dwCreationFlags: DWORD; lpEnvironment: pointer; lpCurrentDirectory: PWideChar;
  const lpStartupInfo: TStartupInfoW;
  var lpProcessInformation: TProcessInformation): BOOL;
var
  restoreLastError: IRestoreLastError;
var
  commandLine: WideString;
begin
  if not assigned(GCreateProcessWithLogonW) then
    GCreateProcessWithLogonW :=
      DSiGetProcAddress('advapi32.dll', 'CreateProcessWithLogonW');
  if assigned(GCreateProcessWithLogonW) then
  begin
    commandLine := lpCommandLine;
      {$IFDEF Unicode}UniqueString(commandLine);{$ENDIF Unicode}
    Result := GCreateProcessWithLogonW(lpUsername, lpDomain, lpPassword,
      dwLogonFlags, lpApplicationName, PWideChar(commandLine),
      dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo,
      lpProcessInformation);
  end
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
  restoreLastError := TRestoreLastError.Create;
end; { DSiCreateProcessWithLogonW }

function DSiCreateEnvironmentBlock(var lpEnvironment: pointer;
  hToken: THandle; bInherit: BOOL): BOOL;
begin
  if not assigned(GCreateEnvironmentBlock) then
    GCreateEnvironmentBlock :=
      DSiGetProcAddress('userenv.dll', 'CreateEnvironmentBlock');
  if assigned(GCreateEnvironmentBlock) then
    Result := GCreateEnvironmentBlock(lpEnvironment, hToken, bInherit)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiCreateEnvironmentBlock }

function DSiDestroyEnvironmentBlock(lpEnvironment: pointer): BOOL;
begin
  if not assigned(GDestroyEnvironmentBlock) then
    GDestroyEnvironmentBlock :=
      DSiGetProcAddress('userenv.dll', 'DestroyEnvironmentBlock');
  if assigned(GDestroyEnvironmentBlock) then
    Result := GDestroyEnvironmentBlock(lpEnvironment)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiDestroyEnvironmentBlock }

//http://msdn2.microsoft.com/en-us/library/aa969510.aspx
function DSiDwmEnableComposition(uCompositionAction: UINT): HRESULT;
begin
  if not assigned(GDwmEnableComposition) then
    GDwmEnableComposition := DSiGetProcAddress('DWMAPI.dll', 'DwmEnableComposition');
  if assigned(GDwmEnableComposition) then
    Result := GDwmEnableComposition(uCompositionAction)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := S_FALSE;
  end;
end; { DSiDwmEnableComposition }

//http://msdn2.microsoft.com/en-us/library/aa969518.aspx
function DSiDwmIsCompositionEnabled(var pfEnabled: BOOL): HRESULT; stdcall;
begin
  if not assigned(GDwmIsCompositionEnabled) then
    GDwmIsCompositionEnabled :=
      DSiGetProcAddress('DWMAPI.dll', 'DwmIsCompositionEnabled');
  if assigned(GDwmIsCompositionEnabled) then
    Result := GDwmIsCompositionEnabled(pfEnabled)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := S_FALSE;
  end;
end; { DSiDwmIsCompositionEnabled }

function DSiEnumProcessModules(hProcess: THandle; lphModule: PModule;
  cb: DWORD; var lpcbNeeded: DWORD): BOOL; stdcall;
begin
  if not assigned(GEnumProcessModules) then
    GEnumProcessModules := DSiGetProcAddress('psapi.dll', 'EnumProcessModules');
  if assigned(GEnumProcessModules) then
    Result := GEnumProcessModules(hProcess, lphModule, cb, lpcbNeeded)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiEnumProcessModules }

function DSiGetModuleFileNameEx(hProcess: THandle; hModule: HMODULE;
  lpFilename: PChar; nSize: DWORD): DWORD; stdcall;
begin
  if not assigned(GGetModuleFileNameEx) then
    GGetModuleFileNameEx := DSiGetProcAddress('psapi.dll',
      'GetModuleFileNameEx' + CAPISuffix);
  if assigned(GGetModuleFileNameEx) then
    Result := GGetModuleFileNameEx(hProcess, hModule, lpFilename, nSize)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := 0;
  end;
end; { DSiGetModuleFileNameEx }

function DSiGetProcessImageFileName(hProcess: THandle; lpImageFileName: PChar;
  nSize: DWORD): DWORD; stdcall;
begin
  if not assigned(GGetProcessImageFileName) then
    GGetProcessImageFileName :=
      DSiGetProcAddress('psapi.dll', 'GetProcessImageFileName' + CAPISuffix);
  if assigned(GGetProcessImageFileName) then
    Result := GGetProcessImageFileName(hProcess, lpImageFileName, nSize)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := 0;
  end;
end; { DSiGetProcessImageFileName }

function DSiGetProcessMemoryInfo(process: THandle; memCounters: PProcessMemoryCounters;
  cb: DWORD): boolean; stdcall;
begin
  if not assigned(GGetProcessMemoryInfo) then
    GGetProcessMemoryInfo := DSiGetProcAddress('psapi.dll', 'GetProcessMemoryInfo');
  if assigned(GGetProcessMemoryInfo) then
    Result := GGetProcessMemoryInfo(process, memCounters, cb)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiGetProcessMemoryInfo }

function DSiGetTickCount64: int64; stdcall;
begin
  if not assigned(GGetTickCount64) then
    GGetTickCount64 := DSiGetProcAddress('kernel32.dll', 'GetTickCount64');
  if assigned(GGetTickCount64) then
    Result := GGetTickCount64()
  else
    raise Exception.Create('Unsupported API: GetTickCount64');
end; { DSiGetTickCount64 }

function DSiGetUserProfileDirectoryW(hToken: THandle; lpProfileDir: PWideChar;
  var lpcchSize: DWORD): BOOL;
begin
  if not assigned(GGetUserProfileDirectoryW) then
    GGetUserProfileDirectoryW :=
      DSiGetProcAddress('userenv.dll', 'GetUserProfileDirectoryW');
  if assigned(GGetUserProfileDirectoryW) then
    Result := GGetUserProfileDirectoryW(hToken, lpProfileDir, lpcchSize)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiGetUserProfileDirectoryW }

function DSiGlobalMemoryStatusEx(memStatus: PMemoryStatusEx): boolean; stdcall;
begin
  if not assigned(GGlobalMemoryStatusEx) then
    GGlobalMemoryStatusEx := DSiGetProcAddress('kernel32.dll', 'GlobalMemoryStatusEx');
  if assigned(GGlobalMemoryStatusEx) then
    Result := GGlobalMemoryStatusEx(memStatus)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiGlobalMemoryStatusEx }

function DSiImpersonateLoggedOnUser(hToken: THandle): BOOL; stdcall;
begin
  if not assigned(GImpersonateLoggedOnUser) then
    GImpersonateLoggedOnUser :=
      DSiGetProcAddress('advapi32.dll', 'ImpersonateLoggedOnUser');
  if assigned(GImpersonateLoggedOnUser) then
    Result := GImpersonateLoggedOnUser(hToken)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiImpersonateLoggedOnUser }

function DSiIsWow64Process(hProcess: THandle; var wow64Process: BOOL): BOOL; stdcall;
begin
  if not assigned(GIsWow64Process) then
    GIsWow64Process := DSiGetProcAddress('kernel32.dll', 'IsWow64Process');
  if assigned(GIsWow64Process) then
    Result := GIsWow64Process(hProcess, wow64Process)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiIsWow64Process }

function DSiLogonUser(lpszUsername, lpszDomain, lpszPassword: PChar;
  dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL;
begin
    {$IFDEF Unicode}
      Result := LogonUser(lpszUsername, lpszDomain, lpszPassword, dwLogonType,
        dwLogonProvider, phToken);
    {$ELSE}
  Result := False;
  if not assigned(GLogonUser) then
    GLogonUser := DSiGetProcAddress('advapi32.dll', 'LogonUserA');
  if assigned(GLogonUser) then
  begin
    if not DSiEnablePrivilege('SeTcbName') and
      DSiEnablePrivilege('SeChangeNotifyName') then
      Exit;
    Result := GLogonUser(lpszUsername, lpszDomain, lpszPassword,
      dwLogonType, dwLogonProvider, phToken);
  end
  else
    SetLastError(ERROR_NOT_SUPPORTED);
    {$ENDIF Unicode}
end; { DSiLogonUser }

function DSiNetApiBufferFree(buffer: pointer): cardinal; stdcall;
begin
  if not assigned(GNetApiBufferFree) then
    GNetApiBufferFree := DSiGetProcAddress('netapi32.dll', 'NetWkstaGetInfo');
  if assigned(GNetApiBufferFree) then
    Result := GNetApiBufferFree(buffer)
  else
    Result := ERROR_NOT_SUPPORTED;
end; { DSiNetApiBufferFree }

function DSiNetWkstaGetInfo(servername: PChar; level: cardinal;
  out bufptr: pointer): cardinal; stdcall;
begin
  if not assigned(GNetWkstaGetInfo) then
    GNetWkstaGetInfo := DSiGetProcAddress('netapi32.dll', 'NetWkstaGetInfo');
  if assigned(GNetWkstaGetInfo) then
    Result := GNetWkstaGetInfo(servername, level, bufptr)
  else
    Result := ERROR_NOT_SUPPORTED;
end; { DSiNetWkstaGetInfo }

function DSiNTNetShareAdd(serverName: PChar; level: integer; buf: PChar;
  var parm_err: integer): DWord;
begin
  if not assigned(GNTNetShareAdd) then
    GNTNetShareAdd := DSiGetProcAddress('netapi32.dll', 'NetShareAdd');
  if assigned(GNTNetShareAdd) then
    Result := GNTNetShareAdd(serverName, level, buf, parm_err)
  else
    Result := ERROR_NOT_SUPPORTED;
end; { DSiNTNetShareAdd }

function DSiNTNetShareDel(serverName: PChar; netName: PWideChar;
  reserved: integer): DWord;
begin
  if not assigned(GNTNetShareDel) then
    GNTNetShareDel := DSiGetProcAddress('netapi32.dll', 'NetShareDel');
  if assigned(GNTNetShareDel) then
    Result := GNTNetShareDel(serverName, netName, reserved)
  else
    Result := ERROR_NOT_SUPPORTED;
end; { DSiNTNetShareDel }

function DSiOpenSCManager(lpMachineName, lpDatabaseName: PChar;
  dwDesiredAccess: DWORD): SC_HANDLE; stdcall;
begin
  if not assigned(GOpenSCManager) then
    GOpenSCManager := DSiGetProcAddress('advapi32.dll', 'OpenSCManager' + CAPISuffix);
  if assigned(GOpenSCManager) then
    Result := GOpenSCManager(lpMachineName, lpDatabaseName, dwDesiredAccess)
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := 0;
  end;
end; { DSiOpenSCManager }

function DSiRevertToSelf: BOOL; stdcall;
begin
  if not assigned(GRevertToSelf) then
    GRevertToSelf := DSiGetProcAddress('advapi32.dll', 'RevertToSelf');
  if assigned(GRevertToSelf) then
    Result := GRevertToSelf
  else
  begin
    SetLastError(ERROR_NOT_SUPPORTED);
    Result := False;
  end;
end; { DSiRevertToSelf }

function DSiSetDllDirectory(path: PChar): boolean; stdcall;
begin
  if not assigned(GSetDllDirectory) then
    GSetDllDirectory := DSiGetProcAddress('kernel32.dll',
      'SetDllDirectory' + CAPISuffix);
  if assigned(GSetDllDirectory) then
    Result := GSetDllDirectory(path)
  else
    Result := False;
end; { DSiSetDllDirectory }

function DSiSetSuspendState(hibernate, forceCritical, disableWakeEvent: BOOL): BOOL;
  stdcall;
begin
  if not assigned(GSetSuspendState) then
    GSetSuspendState := DSiGetProcAddress('PowrProf.dll', 'SetSuspendState');
  if assigned(GSetSuspendState) then
    Result := GSetSuspendState(hibernate, forceCritical, disableWakeEvent)
  else
    Result := False;
end; { DSiSetSuspendState }

function DSiSHEmptyRecycleBin(Wnd: HWND; pszRootPath: PChar;
  dwFlags: DWORD): HRESULT; stdcall;
begin
  if not assigned(GSHEmptyRecycleBin) then
    GSHEmptyRecycleBin := DSiGetProcAddress('shell32.dll',
      'SHEmptyRecycleBin' + CAPISuffix);
  if assigned(GSHEmptyRecycleBin) then
    Result := GSHEmptyRecycleBin(Wnd, pszRootPath, dwFlags)
  else
    Result := S_FALSE;
end; { DSiSHEmptyRecycleBin }

function DSiWow64DisableWow64FsRedirection(var oldStatus: pointer): BOOL; stdcall;
begin
  if not assigned(GWow64DisableWow64FsRedirection) then
    GWow64DisableWow64FsRedirection :=
      DSiGetProcAddress('kernel32.dll', 'Wow64DisableWow64FsRedirection');
  if assigned(GWow64DisableWow64FsRedirection) then
    Result := GWow64DisableWow64FsRedirection(oldStatus)
  else
    Result := False;
end; { DSiWow64DisableWow64FsRedirection }

function DSiWow64RevertWow64FsRedirection(const oldStatus: pointer): BOOL; stdcall;
begin
  if not assigned(GWow64RevertWow64FsRedirection) then
    GWow64RevertWow64FsRedirection :=
      DSiGetProcAddress('kernel32.dll', 'Wow64RevertWow64FsRedirection');
  if assigned(GWow64RevertWow64FsRedirection) then
    Result := GWow64RevertWow64FsRedirection(oldStatus)
  else
    Result := False;
end; { DSiWow64RevertWow64FsRedirection }

{ TRestoreLastError }

constructor TRestoreLastError.Create;
begin
  inherited Create;
  rleLastError := GetLastError;
end; { TRestoreLastError.Create }

destructor TRestoreLastError.Destroy;
begin
  SetLastError(rleLastError);
  inherited;
end; { TRestoreLastError.Destroy }

{ TBackgroundTask }

constructor TBackgroundTask.Create(waitObject: THandle);
begin
  inherited Create;
  btWaitObject := waitObject;
end; { TBackgroundTask.Create }

{ TCleanupAces }

procedure TCleanupAces.Awaited;
begin
  if assigned(caSid) then
  begin
    if caWindowStation <> 0 then
      DSiRemoveAceFromWindowStation(caWindowStation, caSid);
    if caDesktop <> 0 then
      DSiRemoveAceFromDesktop(caDesktop, caSid);
  end;
end; { TCleanupAces.Awaited }

constructor TCleanupAces.Create(waitObject: THandle; windowStation: HWINSTA;
  desktop: HDESK; sid: PSID);
var
  waitHandle: THandle;
begin
  Win32Check(DuplicateHandle(GetCurrentProcess, waitObject, GetCurrentProcess,
    @waitHandle, 0, False, DUPLICATE_SAME_ACCESS));
  inherited Create(waitHandle);
  caWindowStation := windowStation;
  caDesktop := desktop;
  caSid := sid;
end; { TCleanupAces.Create }

destructor TCleanupAces.Destroy;
begin
  if assigned(caSid) then
    HeapFree(GetProcessHeap, 0, caSid);
  if caWindowStation <> 0 then
    CloseWindowStation(caWindowStation);
  if caDesktop <> 0 then
    CloseDesktop(caDesktop);
  inherited;
end; { TCleanupAces.Destroy }

{ TBackgroundThread }

constructor TBackgroundThread.Create(task: TBackgroundTask);
begin
  btTask := task;
  FreeOnTerminate := True;
  inherited Create(False);
end; { TBackgroundThread.Create }

procedure TBackgroundThread.Execute;
begin
  if DSiWaitForTwoObjects(GTerminateBackgroundTasks, btTask.WaitObject,
    False, INFINITE) = WAIT_OBJECT_1 then
    btTask.Awaited;
  FreeAndNil(btTask);
end; { TBackgroundThread.Execute }

{ initialization }

procedure DynaLoadAPIs;
begin
  GInterlockedCompareExchange64 :=
    DSiGetProcAddress('kernel.dll', 'InterlockedCompareExchange64');
end; { DynaLoadAPIs }

initialization
  InitializeCriticalSection(GDSiWndHandlerCritSect);
  GTerminateBackgroundTasks := CreateEvent(nil, False, False, nil);
  GDSiWndHandlerCount := 0;
  GTimeGetTimeBase := 0;
  GLastTimeGetTime := 0;
  if not QueryPerformanceFrequency(GPerformanceFrequency) then
    GPerformanceFrequency := 0;
  GCF_HTML := RegisterClipboardFormat('HTML Format');
  DynaLoadAPIs;
  timeBeginPeriod(1);

finalization
  timeEndPeriod(1);
  DSiCloseHandleAndNull(GTerminateBackgroundTasks);
  DeleteCriticalSection(GDSiWndHandlerCritSect);
  DSiUnloadLibrary;
  FreeAndNil(_GLibraryList);
end.
